home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / COMMADIO / RBBS3.LZH / RBBS-SUB.BAS < prev    next >
BASIC Source File  |  1986-03-15  |  82KB  |  2,112 lines
  1. ' $linesize:132
  2. ' $title: 'RBBS-SUB.BAS CPC14-1A, Copyright 1986 by D. Thomas Mack'
  3. '  Copyright 1986 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBS-SUB.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: March 16, 1986
  7. '  Subsequent Releases.: none
  8. '  Copyright ..........: 1986
  9. '  Purpose.............: The Remote Bulleting Board System for the IBM PC,
  10. '                        RBBS-PC.BAS utilizes a lot of common subroutines.
  11. '                        These are incorporated within RBBS-SUB.BAS as
  12. '                        seperately callable subroutines in order to free
  13. '                        up as much code as possible within the 64K code
  14. '                        segment used by RBBS-PC.BAS.
  15. '  Parameters..........: All parameters are passed via a COMMON statement.
  16. '
  17. '  Subroutine Name       Function of Subroutine
  18. '
  19. '      ALLCAPS           Convert a sting to all upper case characters
  20. '      AMORPM            Calculate the current time as AM or PM
  21. '      ANSWERIT          Answer the telephone when it rings
  22. '      BADFILE           Check for system crash attempt with bad device name
  23. '      BADNAME           Check for system crash attempt with bad file name
  24. '      CARRIER           Test for Carrier present
  25. '      COMMINFO          Get users baud rate and parity in a string format
  26. '      COPYWRIT          Display RBBS-PC's copyright notice
  27. '      DELAYIT           Wait number of seconds specified before returning
  28. '      FILELOCK          Allow files to be shared among multiple RBBS-PC's
  29. '      FINDFREE          Find amount of free space on a device
  30. '      FINDFUNC          Find the function key, if any, that was depressed
  31. '      FINDIT            Find if a file exists on a device
  32. '      FINDTIME          Calculate the number of seconds since midnight
  33. '      GETCOMND          Get RBBS-PC's node id from command line
  34. '      LINE25            Build and/or update line 25 of RBBS-PC's local screen
  35. '      LOGERROR          Log error message to CALLERS file
  36. '      MODEMPUT          Write a modem command string to the modem
  37. '      OPENWORK          Open RBBS-PC's work file (number 2)
  38. '      PRINTIT           Print line on the local PC running RBBS-PC printer
  39. '      READDEF           Open and read RBBS-PC's ".DEF" file of parameters
  40. '      READPROF          Read user's profile on return from a "door"
  41. '      SETBAUD           Set baud rate in the 8250 chip of the RS232 interface
  42. '      SETCRLF           Set up the necessary carriage return/line feed string
  43. '      SKIPLINE          Write a blank line to the communications port
  44. '      TGET              Read a line from the communications port
  45. '      TPUT              Write a line to the communications port
  46. '      UPDTCALR          Update to the caller's file
  47. '
  48. '  $INCLUDE: 'RBBS-VAR.BAS'
  49. '
  50. '  $SUBTITLE: 'Error Handling for seperately compiled subroutines'
  51. '  $PAGE
  52. '
  53. ' *****************************************************************************
  54. ' *  Error handling for the seperately compiled subroutines of RBBS-PC        *
  55. ' *****************************************************************************
  56. '
  57. '
  58. '     PRINTER ERROR HANDLING
  59. '
  60. 65     PRINTER = FALSE
  61.        RESUME 13674
  62. '
  63. '     ANSWERIT ERROR HANDLING
  64. '
  65. 70     IF ERL <> 328 THEN _
  66.           RET.ERL = ERL
  67.        IF (ERL = 328 OR ERL = 275 OR ERL = 324) AND ERR = 57 THEN _
  68.           RESUME 328
  69.        IF ERL = 324 AND ERR = 69 THEN _
  70.           SUBROUTINE.PARAMETER = 5
  71.        EC = ERR
  72.        RESUME 327
  73. '
  74. '     TPUT ERROR HANDLING
  75. '
  76. 75     IF ERL <> 1477 THEN _
  77.           RET.ERR = ERR
  78.        IF ERR = 69 THEN _
  79.           SUBROUTINE.PARAMETER = -1 : _
  80.           RESUME 1477
  81.        IF ERR = 57 THEN _
  82.           RESUME 1477
  83.        EC = ERR
  84.        RESUME 1476
  85. '
  86. '     TGET ERROR HANDLING
  87. '
  88. 80    IF ERR = 57 THEN _
  89.           RESUME 1650
  90.        SUBROUTINE.PARAMETER = -1
  91.        EC = ERR
  92.        RESUME 1651
  93. '
  94. '     FINDIT ERROR HANDLING
  95. '
  96. 85    IF ERL = 20221 AND ERR = 53 THEN _
  97.          RESUME 20224
  98.       IF ERL = 20221 THEN _
  99.          EC = ERR : _
  100.          RESUME 20222
  101.       IF ERL = 20222 AND ERR = 52 THEN _
  102.          RESUME 20223
  103.       IF ERL = 20223 AND EC = 58 THEN _
  104.          EC = 64 : _
  105.          RESUME 20224
  106.       EC = ERR
  107.       RESUME 20224
  108. '
  109. '     FINDFREE ERROR HANDLING
  110. '
  111. 90    IF ERL = 52001 AND ERR = 53 AND Z$ = COMMENTS.FILE$ THEN _
  112.          CLOSE 2 : _
  113.          OPEN "O",2,COMMENTS.FILE$ : _
  114.          RESUME 52000
  115.       IF ERL = 52001 AND ERR = 53 AND Z$ = UPLOAD.DIRECTORY$ THEN _
  116.          A$ = "Upload directory file missing. Please tell SYSOP" : _
  117.          SUBROUTINE.PARAMETER = 6 : _
  118.          CALL TPUT : _
  119.          RESUME 52002
  120.       EC = ERR
  121.       RESUME 52002
  122. '
  123. '     OPENWORK ERROR HANDLING
  124. '
  125. 95    EC = ERR
  126.       IF ERR = 52 THEN _
  127.          RESUME 58010
  128.       RESUME 58030
  129. '  $SUBTITLE: 'COPYWRIT - subroutine to display RBBS-PC copyright'
  130. '  $PAGE
  131. '
  132. '  SUBROUTINE NAME    -- COPYWRIT
  133. '
  134. '  INPUT PARAMETERS   --  NONE
  135. '
  136. '  OUTPUT PARAMETERS  --  NONE
  137. '
  138. '  SUBROUTINE PURPOSE --  TO DISPLAY RBBS-PC'S COPYRIGHT NOTICE ON THE LOCAL
  139. '                         SYSOP'S SCREEN
  140. '
  141.       SUB COPYWRIT STATIC
  142.    WIDTH 80
  143.    CLS
  144.    KEY OFF
  145.    LOCATE ,,0
  146.    PRINT TAB(60)"tm"
  147.    PRINT TAB(16) STRING$(15,205)" U S E R W A R E " STRING$(15,205)
  148.    PRINT
  149.    PRINT TAB(17)"Capital PC User Group User-Supported Software"
  150.    PRINT
  151.    PRINT TAB(5) CHR$(214) STRING$(66,196) CHR$(183)
  152.    FOR I = 1 TO 12
  153.      READ A$
  154.      PRINT TAB(5) CHR$(186);A$; SPACE$(66 - LEN(A$)); CHR$(186)
  155.    NEXT
  156.    PRINT TAB(5) CHR$(211) STRING$(66,196) CHR$(189)
  157.    PRINT TAB(21)"Copyright (c) 1983, 84, 85, 86 Tom Mack, 10210 Oxfordshire Rd., Great Falls, VA"
  158.    DATA "    If you are using RBBS-PC CPC14.1 and find it valuable, I"
  159.    DATA "    suggest you consider a contribution to"
  160.    DATA ""
  161.    DATA "                 Capital PC Software Exchange"
  162.    DATA "                     Post Office Box 6128"
  163.    DATA "                Silver Spring, Maryland  20906"
  164.    DATA ""
  165.    DATA "    You are free to copy and share RBBS-PC CPC14.1 with"
  166.    DATA "    others on these three conditions:"
  167.    DATA "      1.  This program is not distributed in modified form."
  168.    DATA "      2.  No fee or consideration is charged for RBBS-PC, itself."
  169.    DATA "      3.  This notice is not bypassed or removed."
  170.    SUBROUTINE.PARAMETER = 8
  171.    CALL DELAYIT
  172.    END SUB
  173. ' $SUBTITLE: 'GETCOMND - subroutine to get command from command line'
  174. ' $PAGE
  175. '
  176. '  SUBROUTINE NAME    -- GETCOMND
  177. '
  178. '  INPUT PARAMETERS   -- COMMAND FROM COMMAND LINE
  179. '
  180. '  OUTPUT PARAMETERS  --     PARAMETER                    MEANING
  181. '                         NODE.RECORD.INDEX    RECORD NUMBER WITHIN THE
  182. '                                              MESSAGES FILE FOR THIS "NODE"
  183. '                                              (RANGE IS 2 TO 36)
  184. '                         CONFIG.FILENAME$     NAME OF RBBS-PC ".DEF" FILE
  185. '                                              FOR THIS COPY RBBS-PC TO USE
  186. '
  187. '  SUBROUTINE PURPOSE --  TO GET NODE ID FROM COMMAND LINE
  188. '
  189.       SUB GETCOMND STATIC
  190. '
  191. ' *****************************************************************************
  192. ' *  GET NODE ID FROM COMMAND LINE                                            *
  193. ' *****************************************************************************
  194. '
  195.       PM$ = COMMAND$
  196.       IF LEN(PM$) = 0 THEN _
  197.          PM$ = "-"
  198.       NODE.RECORD.INDEX = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(PM$,1))
  199.       IF NODE.RECORD.INDEX < 2 THEN _
  200.          NODE.RECORD.INDEX = 2 : _
  201.          MID$(CONFIG.FILENAME$,5,1) = "-" : _
  202.          NODE.ID$ = "1" : _
  203.          EXIT SUB
  204.       NODE.ID$ = STR$(NODE.RECORD.INDEX-1)
  205.       MID$(CONFIG.FILENAME$,5,1) = PM$
  206.       END SUB
  207. ' $SUBTITLE: 'READDEF - subroutine to read RBBS-PC.DEF file'
  208. ' $PAGE
  209. '
  210. '  SUBROUTINE NAME    -- READDEF
  211. '
  212. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  213. '                         CONFIG.FILENAME$    NAME OF RBBS-PC.DEF FILE TO READ
  214. '
  215. '  OUTPUT PARAMETERS  --  ALL THE RBBS-PC.DEF PARAMETERS
  216. '
  217. '  SUBROUTINE PURPOSE --  TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
  218.      SUB READDEF STATIC
  219. '
  220. ' *****************************************************************************
  221. ' *  OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS                          *
  222. ' *****************************************************************************
  223. '
  224. 117 OPEN "I",2,CONFIG.FILENAME$
  225.     INPUT #2,DOWNLOAD.DRIVES$, _
  226.              SYSOP.PASSWORD.1$, _
  227.              SYSOP.PASSWORD.2$, _
  228.              SYSOP.FIRST.NAME$, _
  229.              SYSOP.LAST.NAME$, _
  230.              REQUIRED.RINGS, _
  231.              START.OFFICE.HOURS, _
  232.              END.OFFICE.HOURS, _
  233.              MINUTES.PER.SESSION!, _
  234.              DF, _
  235.              DF, _
  236.              UPLOAD.DIRECTORY$, _
  237.              EXPERT.USER, _
  238.              ACTIVE.BULLETINS, _
  239.              PROMPT.BELL, _
  240.              DF, _
  241.              DF, _
  242.              MENU$(1), _
  243.              MENU$(2), _
  244.              MENU$(3), _
  245.              MENU$(4), _
  246.              MENU$(5), _
  247.              CONFERENCE.MENU$, _
  248.              DF, _
  249.              WELCOME.INTERRUPTABLE, _
  250.              REMIND.FILE.TRANSFERS, _
  251.              PAGE.LENGTH, _
  252.              MAX.MESSAGE.LINES, _
  253.              DOORS.AVAILABLE, _
  254.              DF$
  255.     INPUT #2,MAIN.MESSAGE.FILE$, _
  256.              MAIN.MESSAGE.BACKUP$, _
  257.              CALLERS.FILE$, _
  258.              COMMENTS.FILE$, _
  259.              MAIN.USER.FILE$, _
  260.              WELCOME.FILE$, _
  261.              NEWUSER.FILE$, _
  262.              DIRECTORY.EXTENTION$, _
  263.              COM.PORT$, _
  264.              BULLETINS.OPTIONAL, _
  265.              MODEM.INIT.COMMAND$, _
  266.              DF$, _
  267.              DOS.VERSION, _
  268.              FG, _
  269.              BG, _
  270.              BORDER, _
  271.              RBBS.BAT$, _
  272.              RCTTY.BAT$
  273.     INPUT #2,OMIT.MAIN.DIRECTORY$, _
  274.              OMIT.UPLOAD.DIRECTORY$, _
  275.              HELP$(1), _
  276.              HELP$(2), _
  277.              HELP$(3), _
  278.              HELP$(4), _
  279.              HELP$(5), _
  280.              HELP$(6), _
  281.              HELP$(7), _
  282.              HELP$(8), _
  283.              HELP$(9), _
  284.              BULLETIN.MENU$, _
  285.              BULLETIN.PREFIX$, _
  286.              DF$, _
  287.              MESSAGE.REMINDER, _
  288.              REQUIRE.NON.ASCII, _
  289.              DOORS.SECURITY.LEVEL, _
  290.              MAXIMUM.NUMBER.OF.NODES, _
  291.              NETWORK.TYPE, _
  292.              RECYCLE.TO.DOS, _
  293.              DF, _
  294.              DF, _
  295.              TRASHCAN.FILE$
  296.     INPUT #2,MINIMUM.LOGON.SECURITY, _
  297.              DEFAULT.SECURITY.LEVEL, _
  298.              SYSOP.SECURITY.LEVEL, _
  299.              FILESEC.FILE$, _
  300.              SYSOP.MENU.SECURITY.LEVEL, _
  301.              LOCAL.PASSWORD$, _
  302.              MAXIMUM.VIOLATIONS, _
  303.              SYSOP.FUNCTION(1), _
  304.              SYSOP.FUNCTION(2), _
  305.              SYSOP.FUNCTION(3), _
  306.              SYSOP.FUNCTION(4), _
  307.              SYSOP.FUNCTION(5), _
  308.              SYSOP.FUNCTION(6), _
  309.              SYSOP.FUNCTION(7), _
  310.              PASSWORDS.FILE$, _
  311.              MAXIMUM.PASSWORD.CHANGES, _
  312.              MINIMUM.SECURITY.FOR.TEMP.PASSWORD, _
  313.              OVERWRITE.SECURITY.LEVEL, _
  314.              DOORS.TERMINAL.TYPE, _
  315.              LIMIT.DAILY.TIME
  316.     INPUT #2,MAIN.FUNCTION(1), _
  317.              MAIN.FUNCTION(2), _
  318.              MAIN.FUNCTION(3), _
  319.              MAIN.FUNCTION(4), _
  320.              MAIN.FUNCTION(5), _
  321.              MAIN.FUNCTION(6), _
  322.              MAIN.FUNCTION(7), _
  323.              MAIN.FUNCTION(8), _
  324.              MAIN.FUNCTION(9), _
  325.              MAIN.FUNCTION(10), _
  326.              MAIN.FUNCTION(11), _
  327.              MAIN.FUNCTION(12), _
  328.              MAIN.FUNCTION(13), _
  329.              MAIN.FUNCTION(14), _
  330.              MAIN.FUNCTION(15), _
  331.              MAIN.FUNCTION(16), _
  332.              MAIN.FUNCTION(17), _
  333.              MAIN.FUNCTION(18), _
  334.              MAIN.FUNCTION(19), _
  335.              MAIN.FUNCTION(20), _
  336.              MAIN.FUNCTION(21), _
  337.              DEFAULT.MACHINE.TYPE$, _
  338.              WAIT.BEFORE.DISCONNECT
  339.     INPUT #2,FILES.FUNCTION(1), _
  340.              FILES.FUNCTION(2), _
  341.              FILES.FUNCTION(3), _
  342.              FILES.FUNCTION(4), _
  343.              FILES.FUNCTION(5), _
  344.              FILES.FUNCTION(6), _
  345.              FILES.FUNCTION(7), _
  346.              FILES.FUNCTION(8), _
  347.              FILES.FUNCTION(9), _
  348.              FILES.FUNCTION(10), _
  349.              UTILITY.FUNCTION(1), _
  350.              UTILITY.FUNCTION(2), _
  351.              UTILITY.FUNCTION(3), _
  352.              UTILITY.FUNCTION(4), _
  353.              UTILITY.FUNCTION(5), _
  354.              UTILITY.FUNCTION(6), _
  355.              UTILITY.FUNCTION(7), _
  356.              UTILITY.FUNCTION(8), _
  357.              UTILITY.FUNCTION(9), _
  358.              UTILITY.FUNCTION(10), _
  359.              UTILITY.FUNCTION(11), _
  360.              UTILITY.FUNCTION(12), _
  361.              UTILITY.FUNCTION(13), _
  362.              UTILITY.FUNCTION(14), _
  363.              UTILITY.FUNCTION(15), _
  364.              UTILITY.FUNCTION(16), _
  365.              UPLOAD.TIME.FACTOR!, _
  366.              COMPUTER.TYPE, _
  367.              REMIND.PROFILE, _
  368.              RBBS.NAME$, _
  369.              COMMANDS.BETWEEN.RINGS, _
  370.              MNP.SUPPORT, _
  371.              PAGING.PRINTER.SUPPORT$, _
  372.              MODEM.INIT.BAUD$
  373.     FOR FUNCTION.KEY.INDEX = 1 TO 12
  374.       INPUT #2,SYSOP.FUNCTION.KEY$(FUNCTION.KEY.INDEX)
  375.     NEXT
  376. '
  377. ' *****************************************************************************
  378. ' *  ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS                      *
  379. ' *  GET DOS SUB-DIRECTORY RBBS-PC OPTIONS                                    *
  380. ' *****************************************************************************
  381. '
  382.     INPUT #2, DF,_
  383.               SUBDIR.COUNT,_
  384.               DF,_
  385.               UPLOAD.TO.SUBDIR,_
  386.               DF,_
  387.               UPLOAD.SUBDIR$,_
  388.               RESTRICT.BAUD,_
  389.               USE.COLOR,_
  390.               DISKFULL.GO.OFFLINE,_
  391.               EXTENDED.LOGGING,_
  392.               MODEM.RESET.COMMAND$,_
  393.               MODEM.COUNT.RINGS.COMMAND$,_
  394.               MODEM.ANSWER.COMMAND$,_
  395.               MODEM.GO.OFFHOOK.COMMAND$,_
  396.               DISK.FOR.DOS$, _
  397.               DUMB.MODEM, _
  398.               COMMENTS.AS.MESSAGES, _
  399.               LSB,_
  400.               MSB,_
  401.               LINE.CONTROL.REGISTER,_
  402.               MODEM.CONTROL.REGISTER,_
  403.               LINE.STATUS.REGISTER,_
  404.               MODEM.STATUS.REGISTER
  405. '
  406. ' *****************************************************************************
  407. ' *  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE                             *
  408. ' *****************************************************************************
  409. '
  410.     IF SUBDIR.COUNT<1 THEN _
  411.        GOTO 123
  412.     FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT
  413.         INPUT #2,SUBDIR$
  414.         SUBDIR$(SUBDIR.INDEX) = SUBDIR$ + "\"
  415.     NEXT
  416.     GOTO 125
  417. '
  418. ' *****************************************************************************
  419. ' *  SETUP DOWNLOAD DRIVES WITH NO SUBDIRECTORY SUPPORT                       *
  420. ' *****************************************************************************
  421. '
  422. 123 FOR SUBDIR.INDEX = 1 TO LEN(DOWNLOAD.DRIVES$) - 1
  423.         SUBDIR$(SUBDIR.INDEX) = MID$(DOWNLOAD.DRIVES$,SUBDIR.INDEX,1) + ":"
  424.     NEXT
  425.     SUBDIR.COUNT = LEN(DOWNLOAD.DRIVES$) - 1
  426. '
  427. ' *****************************************************************************
  428. ' *  SETUP UPLOAD DRIVE AND DIRECTORY.NAME                                    *
  429. ' *****************************************************************************
  430. '
  431. 125 UPLOAD.DIR.CHECK$ = UPLOAD.DIRECTORY$
  432.     SUBDIR.COUNT = SUBDIR.COUNT + 1
  433.     IF UPLOAD.TO.SUBDIR THEN _
  434.        SUBDIR$(SUBDIR.COUNT) = UPLOAD.SUBDIR$ + "\" _
  435.     ELSE SUBDIR$(SUBDIR.COUNT) = RIGHT$(DOWNLOAD.DRIVES$,1) + _
  436.          ":"
  437.     UPLOAD.DIRECTORY$ = SUBDIR$(SUBDIR.COUNT) + _
  438.                         UPLOAD.DIRECTORY$ + _
  439.                         "." + _
  440.                         DIRECTORY.EXTENTION$
  441.     CLOSE #2
  442.     END SUB
  443. ' $SUBTITLE: 'ANSWERIT - subroutine to answer the phone when it rings'
  444. ' $PAGE
  445. '
  446. '  SUBROUTINE NAME    -- ANSWERIT
  447. '
  448. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  449. '                       SUBROUTINE.PARAMETER = 1   WAIT FOR PHONE TO RING
  450. '                       SUBROUTINE.PARAMETER = 2   CONTINUE LOOKING FOR CONNECT
  451. '                       SUBROUTINE.PARAMETER = 3   RENTRY AFTER FUNCTION KEY
  452. '                       SUBROUTINE.PARAMETER = 4   GO ON LINE IMMEDIATELY
  453. '                       BG                         LOCAL DISPLAY'S BACKGROUND
  454. '                       BORDER                     LOCAL DISPLAY'S BORDER COLOR
  455. '                       COLOR.SUPPORT              ANSI.SYS SUPPORT INDICATOR
  456. '                       COM.PORT$                  COMMUNICATIONS PORT NAME
  457. '                       COMPUTER.TYPE              TYPE OF COMPUTER RUNNING ON
  458. '                       DUMB.MODEM                 NON-HAYES TYPE MODEM FLAG
  459. '                       EXTENDED.LOGGING           EXTENDED CALLERS LOG FLAG
  460. '                       FG                         LOCAL DISPLAY'S FOREGROUND
  461. '                       MODEM.ANSWER.COMMAND$      COMMAND TO ANSWER PHONE
  462. '                       MODEM.CONTROL.REGISTER     LOCATION OF MODEM CNTRL. REG
  463. '                       MODEM.COUNT.RINGS.COMMAND$ COMMAND TO COUNT PHONE RINGS
  464. '                       MODEM.INIT.BAUD$           BAUDE AT WHICH TO OPEN COMM.
  465. '                       MODEM.RESET.COMMAND$       COMMAND TO RESET THE MODEM
  466. '                       MODEM.STATUS.REGISTER      LOCATION OF MODEM STATUS REG
  467. '                       PRINTER                    FLAG TO PRINT ON LOCAL PRT.
  468. '                       RESTRICT.BAUD              FLAG TO DISALLOW 300 BAUD
  469. '                       REQUIRED.RINGS             NUMBER OF RINGS TO ANSWER ON
  470. '                       SNOOP                      FLAG TO DISPLAY ON LOCAL PC
  471. '                       SYSOP.NEXT                 FLAG TO GIVE SYSOP CONTROL
  472. '
  473. '  OUTPUT PARAMETERS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
  474. '                       EIGHT.BIT                  PARITY INDICATOR
  475. '
  476. '  SUBROUTINE PURPOSE -- TO ANSWER THE TELEPHONE WHEN IT RINGS.
  477. '
  478.    SUB ANSWERIT STATIC
  479.    ON ERROR GOTO 70
  480.    EC = 0
  481.    FF = SUBROUTINE.PARAMETER
  482.    SUBROUTINE.PARAMETER = 0
  483.    ON FF GOTO 201,324,245,320
  484. '
  485. ' *****************************************************************************
  486. ' *  INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS          *
  487. ' *****************************************************************************
  488. '
  489. 201 IF INP(MODEM.STATUS.REGISTER) < 128 THEN _
  490.        WHILE(INP(MODEM.STATUS.REGISTER) AND &H40) > 0 : _
  491.        WEND : _
  492.        OUT MODEM.CONTROL.REGISTER,&H4 : _
  493.        SUBROUTINE.PARAMETER = 3 : _
  494.        CALL DELAYIT : _
  495.        OUT MODEM.CONTROL.REGISTER,&H0
  496. 210 OPEN COM.PORT$ + ":" + MODEM.INIT.BAUD$ + ",N,8,1,RS,CD,DS" AS #3
  497. 220 SUBROUTINE.PARAMETER = 1
  498.     CALL AMORPM
  499. 230 IF PRINTER THEN _
  500.        Z$ = " RBBS-PC VERSION "+VERSION.ID$+" Node "+NODE.ID$+" up at "+TIM$+" on "+DATE$ : _
  501.        CALL PRINTIT
  502. 235 EIGHT.BIT = TRUE
  503.     IF INP(MODEM.STATUS.REGISTER) > 128 THEN _
  504.        CALL READPROF : _
  505.        SUBROUTINE.PARAMETER = 1 : _
  506.        EXIT SUB
  507.     A$ = MODEM.RESET.COMMAND$
  508.     CALL MODEMPUT
  509.     IF COMPUTER.TYPE = 2 AND COM.PORT$ = "COM1" AND MODEM.STATUS.REGISTER = 1022 THEN _
  510.        SUBROUTINE.PARAMETER = 9 : _
  511.        CALL DELAYIT
  512.     SUBROUTINE.PARAMETER = 3 :
  513.     CALL DELAYIT
  514.     A$ = MODEM.INIT.COMMAND$
  515.     CALL MODEMPUT
  516.     PRINT
  517.     PRINT "READY FOR CALLS AT ";TIM$;" ON "; DATE$
  518.     PRINT
  519.     PRINT "<SCREEN CLEARS TO PREVENT BURN IN>"
  520.     PRINT
  521.     IF RESTRICT.BAUD THEN _
  522.        PRINT "300 BAUD NOT ALLOWED   ";
  523.     IF COLOR.SUPPORT THEN _
  524.        PRINT "ANSI COLOR SUPPORT ACTIVE   ";
  525.     IF EXTENDED.LOGGING THEN _
  526.        PRINT "EXTENDED CALLER LOGGING"
  527.     PRINT
  528.     IF REQUIRED.RINGS = 0 THEN PRINT "WAITING FOR CARRIER"
  529.     IF REQUIRED.RINGS = 255 THEN PRINT "RING BACK SYSTEM SPECIFIED"
  530.     IF REQUIRED.RINGS > 0 AND _
  531.        REQUIRED.RINGS < 255 THEN _
  532.        PRINT "WAITING FOR RING ";REQUIRED.RINGS
  533. '
  534. ' *****************************************************************************
  535. ' *  GET READY TO ANSWER INCOMMING CALL:                                      *
  536. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.                        *
  537. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.            *
  538. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.                *
  539. ' *           REQUIRED RINGS > 0 AND S0 = 0 IN MODEM INIT COMMAND.            *
  540. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER    *
  541. ' *           FIRST CALLS AND THEN HANGS UP (I.E. RING-BACK).                 *
  542. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.          *
  543. ' *****************************************************************************
  544. '
  545.     CALL FINDTIME (TCA!)
  546.     SUBROUTINE.PARAMETER = 1
  547.     CALL LINE25
  548.     QQ = 255
  549.     I = INSTR(MODEM.INIT.COMMAND$,"S0")
  550.     IF I = 0 THEN _
  551.        GOTO 239
  552.     IF VAL(MID$(MODEM.INIT.COMMAND$,I+3,3)) = 255 THEN _
  553.        QQ = 0 : _
  554.        BLK = QQ
  555. 239 RINGBACK.WAIT.STARTED! = 0
  556.     IF REQUIRED.RINGS > 0 AND QQ=0 THEN _
  557.        CALL FINDTIME (RINGBACK.WAIT.STARTED!) : _
  558.        COLOR 7,0,0 _
  559.     ELSE COLOR FG,BG,BORDER
  560. 240 IF SYSOP.NEXT THEN _
  561.        SUBROUTINE.PARAMETER = 3 : _
  562.        EXIT SUB
  563. '
  564. ' *****************************************************************************
  565. ' * WAIT FOR INCOMING CALLS                                                   *
  566. ' *****************************************************************************
  567. '
  568. 245 WHILE INP(MODEM.STATUS.REGISTER) < 128
  569.       CALL FINDFUNC
  570.       IF FUNCTION.KEY >0 THEN _
  571.          SUBROUTINE.PARAMETER = 6 : _
  572.          EXIT SUB
  573. 250   IF KEY.PRESSED$ = ESCAPE$ THEN _
  574.          SUBROUTINE.PARAMETER = 3 : _
  575.          EXIT SUB
  576. 260   IF RINGBACK.WAIT.STARTED! > 0 THEN _
  577.          CALL FINDTIME (TI!) : _
  578.          IF TI! - RINGBACK.WAIT.STARTED! > 45 THEN _
  579.             RINGBACK.WAIT.STARTED! = 0 : _
  580.             RING.BACK.COUNT = 0 : _
  581.             Q = 0 : _
  582.             IF (SNOOP AND REQUIRED.RINGS) THEN _
  583.                PRINT "Ringback timeout";PAGING.PRINTER.SUPPORT$ : _
  584.                IF BLK THEN _
  585.                   QQ = 0 _
  586.                ELSE QQ = 255
  587. 265   CALL FINDTIME (TI!)
  588.       IF TI! - TCA! > 120 THEN _
  589.          LOCATE ,,0 : _
  590.          CLS : _
  591.          CALL FINDTIME (TCA!)
  592. 266   IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 AND _
  593.          REQUIRED.RINGS > 0 THEN _
  594.          GOTO 275
  595. 270 WEND
  596.     IF REQUIRED.RINGS = 0 THEN _
  597.        GOTO 321
  598. '
  599. ' *****************************************************************************
  600. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 0) OR    *
  601. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --     *
  602. ' * "RING BACK."                                                              *
  603. ' *****************************************************************************
  604. '
  605. 275 ON ERROR GOTO 70
  606.     IF LOC(3) THEN _
  607.        X$ = INPUT$(LOC(3),3)
  608.     A$ = MODEM.COUNT.RINGS.COMMAND$
  609.     CALL MODEMPUT
  610.     SUBROUTINE.PARAMETER = 1
  611.     CALL DELAYIT
  612. 290 X$ = INPUT$(LOC(3),3)
  613.     IF LEN(X$) = 0 THEN _
  614.        X$=STR$(RING.BACK.COUNT)
  615.     A$ = ""
  616.     IF QQ = 0 AND Q < VAL(X$) THEN _
  617.        Q = VAL(X$) : _
  618.        GOTO 305
  619. 300 RING.BACK.COUNT = RING.BACK.COUNT + 1
  620.     A$ = STR$(RING.BACK.COUNT)
  621.     IF QQ = 0 THEN _
  622.        RING.BACK.COUNT = VAL(X$) : _
  623.        A$ = STR$(RING.BACK.COUNT)
  624. 305 IF SNOOP THEN _
  625.        PRINT TIME$ + " Ring " + A$ + PAGING.PRINTER.SUPPORT$
  626. 310 IF RING.BACK.COUNT < REQUIRED.RINGS THEN _
  627.        GOTO 239
  628. 320 A$ = MODEM.ANSWER.COMMAND$
  629.     CALL MODEMPUT
  630. '
  631. ' *****************************************************************************
  632. ' *  TEST FOR CARRIER PRESENT                                                 *
  633. ' *****************************************************************************
  634. '
  635. 321 CALL FINDTIME (CONNECT.DELAY!)
  636.     CONNECT.DELAY! = CONNECT.DELAY! + 30
  637.     MODEM.RESPONSE$ = ""
  638. 322 CALL FINDTIME (TI!)
  639.     IF INP(MODEM.STATUS.REGISTER) < 128 AND TI! < CONNECT.DELAY! THEN _
  640.        GOTO 322
  641.     IF INP(MODEM.STATUS.REGISTER) < 128 THEN _
  642.        SUBROUTINE.PARAMETER = 4 : _
  643.        EXIT SUB
  644.     SUBROUTINE.PARAMETER = 3 :
  645.     CALL DELAYIT
  646. 324 ON ERROR GOTO 70
  647.     MODEM.RESPONSE$ = MODEM.RESPONSE$ + INPUT$(LOC(3),3)
  648.     PRINT MODEM.RESPONSE$
  649.     CALL FINDTIME (TI!)
  650.     IF TI! > CONNECT.DELAY! THEN _
  651.        Z$ = "Connect timeout" : _
  652.        SUBROUTINE.PARAMETER = 1 : _
  653.        CALL UPDTCALR : _
  654.        SUBROUTINE.PARMETER = 4 : _
  655.        EXIT SUB
  656. 325 IF DUMB.MODEM THEN _
  657.        BAUD.TEST = VAL(MODEM.INIT.BAUD$) : _
  658.        GOTO 326
  659.     IF INSTR(MODEM.RESPONSE$,"CONNECT") THEN _
  660.        BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"CONNECT") + 8,4)) : _
  661.        GOTO 326
  662.     GOTO 324
  663. 326 SUBROUTINE.PARAMETER = 2
  664. 327 ON ERROR GOTO 0
  665.     EXIT SUB
  666. 328 ON ERROR GOTO 70
  667.     LINE.STATUS = INP(LINE.STATUS.REGISTER)
  668.     IF RET.ERL = 275 THEN _
  669.        GOTO 275
  670.     GOTO 324
  671.     END SUB
  672. ' $SUBTITLE: 'LINE25 - subroutine to build/display RBBS-PCs line 25'
  673. ' $PAGE
  674. '
  675. '  SUBROUTINE NAME    -- LINE25
  676. '
  677. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  678. '                        SUBROUTINE.PARAMETER = 1  BUILD DISPLAY FOR LINE 25
  679. '                        SUBROUTINE.PARAMETER = 2  UPDATE LINE 25
  680. '                        LOCK.STATUS$              STATUS OF LOCKS IN A MULTI-
  681. '                                                  USER ENVIRONMENT OR TIME OF
  682. '                                                  DAY USER LOGGED ON OR THE
  683. '                                                  RE-CYCLED
  684. '
  685. '  OUTPUT PARAMETERS  -- CURSOR.LINE               CURRENT LINE ON SCREEN
  686. '                        CURSOR.ROW                CURRENT ROW ON CURSOR.LINE
  687. '
  688. '  SUBROUTINE PURPOSE -- TO BUILD OR UPDATE RBBS-PC'S LINE 25 DISPLAYED
  689. '                        ON THE PC SCREEN THAT IS RUNNING RBBS-PC.
  690. '
  691.       SUB LINE25 STATIC
  692.       ON SUBROUTINE.PARAMETER GOTO 949,950
  693. '
  694. ' *****************************************************************************
  695. ' *  BUILD LINE 25 DISPLAY                                                    *
  696. ' *****************************************************************************
  697. '
  698. 949 LINE.25$ = MID$("    AVL ",1-4*SYSOP.AVAILABLE,4) + _
  699.                MID$("    ANY ",1-4*SYSOP.ANNOY,4) + _
  700.                MID$("    LPT ",1-4*PRINTER,4) + _
  701.                MID$("SYS",1,-3*SYSOP.NEXT)
  702. '
  703. ' *****************************************************************************
  704. ' *  LINE 25 UPDATE ROUTINE                                                   *
  705. ' *****************************************************************************
  706. '
  707. 950 IF NOT SNOOP THEN _
  708.        EXIT SUB
  709.     CURSOR.LINE = CSRLIN
  710.     CURSOR.ROW = POS(0)
  711.     HH = LEN(ACTIVE.USER.NAME$) + LEN(CI$) + LEN(LINE.25$) + 18
  712.     LOCATE 25,1
  713.     IF NETWORK.TYPE = 0 THEN _
  714.        LOCK.STATUS$ = SPACE$(3)+TIME.LOGGED.ON$
  715.     IF HH>79 THEN _
  716.        HH=78
  717.     PRINT LINE.25$+SPACE$(79-HH)+STR$(USER.SECURITY.LEVEL)+" "+ACTIVE.USER.NAME$+" "+CI$+" "+LOCK.STATUS$;
  718.     LOCATE CURSOR.LINE,CURSOR.ROW
  719.     END SUB
  720. ' $SUBTITLE: 'TPUT -- RBBS-PC common routine to write to comm. port'
  721. ' $PAGE
  722. '
  723. '  SUBROUTINE NAME    -- TPUT (TERMINAL PUT)
  724. '
  725. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  726. '                                A$                 STRING TO WRITE TO THE
  727. '                                                   COMMUNICATIONS PORT
  728. '                         SUBROUTINE.PARAMETER = 1  SKIP A LINE BEFORE WRITING
  729. '                                                   TO THE COMMUNICATIONS PORT
  730. '                         SUBROUTINE.PARAMETER = 2  SKIP A LINE BEFORE WRITING
  731. '                                                   TO THE COMMUNICATIONS PORT
  732. '                                                   AND THEN SKIP TWO LINES
  733. '                                                   AFTER WRITING TO THE COMM-
  734. '                                                   UNICATIONS PORT
  735. '                         SUBROUTINE.PARAMETER = 3  WRITE TO THE COMMUNICATIONS
  736. '                                                   PORT AND THEN SKIP TWO
  737. '                                                   LINES
  738. '                         SUBROUTINE.PARAMETER = 4  WRITE TO THE COMMUNICATIONS
  739. '                                                   PORT WITHOUT A CR/LF
  740. '                         SUBROUTINE.PARAMETER = 5  WRITE TO THE COMMUNICATIONS
  741. '                                                   PORT WITH A CR/LF
  742. '                         SUBROUTINE.PARAMETER = 6  RESET EVERYTHING FOR INPUT
  743. '                                                   STRING
  744. '                         SUBROUTINE.PARAMETER = 7  RE-ENTRY AFTER HANDLING A
  745. '                                                   FUNCTION KEY
  746. '
  747. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  748. '                         FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  749. '
  750. '  SUBROUTINE PURPOSE --  COMMON OUTPUT ROUTINE FOR RBBS-PC TO THE
  751. '                         COMMUNICATIONS PORT (TERMINAL PUT)
  752.      SUB TPUT STATIC
  753.      HALT.IT = 0
  754.      IF SUBROUTINE.PARAMETER <> 7 THEN _
  755.         PARM = SUBROUTINE.PARAMETER
  756.      ON SUBROUTINE.PARAMETER GOTO 1398,1399,1400,1403,1405,1450,1411
  757. '
  758. ' *****************************************************************************
  759. ' *  COMMON OUTPUT ROUTINE                                                    *
  760. ' *****************************************************************************
  761. '
  762. 1398 CALL SKIPLINE
  763.      GOTO 1405
  764. 1399 CALL SKIPLINE
  765. 1400 CR = 1
  766. 1403 CR = CR + 1
  767. 1405 RET = FALSE
  768.      IF NOT STOP.INTERRUPTS OR CM OR INP(MODEM.STATUS.REGISTER) <128 THEN _
  769.         GOTO 1435
  770. 1410 CALL FINDFUNC
  771.      IF FUNCTION.KEY <> 0 THEN _
  772.         EXIT SUB
  773. 1411 Y$ = KEY.PRESSED$
  774.      SUBROUTINE.PARAMETER = PARM
  775.      IF LOCAL.USER THEN _
  776.         GOTO 1430
  777.      IF EOF(3) THEN _
  778.         CALL CARRIER : _
  779.         IF SUBROUTINE.PARAMETER = -1 THEN _
  780.            EXIT SUB ELSE _
  781.         GOTO 1430
  782. 1419 ON ERROR GOTO 75
  783. 1420 Y$ = INPUT$(1,3)
  784. 1425 ON ERROR GOTO 0
  785.      IF SUBROUTINE.PARAMETER = -1 THEN _
  786.         EXIT SUB
  787.      IF Y$ = XOFF$ THEN _
  788.         WHILE EOF(3) : _
  789.            CALL CARRIER : _
  790.            IF SUBROUTINE.PARAMETER = -1 THEN _
  791.               EXIT SUB ELSE _
  792.         WEND : _
  793.         GOTO 1419
  794. 1430 IF Y$ = CHR$(11) AND STOP.INTERRUPTS THEN _
  795.         GOTO 1475
  796.      IF Y$ = CANCEL$ AND STOP.INTERRUPTS THEN _
  797.         GOTO 1475
  798. 1435 IF NOT SNOOP THEN _
  799.         GOTO 1437
  800.      LOCATE ,,1
  801.      IF COLOR.SUPPORT AND A$ <> "" THEN _
  802.         CALL ANSI(A$,C.C,C.L) : _
  803.         LOCATE C.C,C.L : _
  804.         GOTO 1437
  805.      CURSOR.ROW = 1
  806.      WHILE CURSOR.ROW <= LEN(A$)
  807.        CURSOR.LINE = CURSOR.ROW + _
  808.                      INSTR(MID$(A$,CURSOR.ROW) + _
  809.                      CARRIAGE.RETURN$,CARRIAGE.RETURN$) - 2
  810.        PRINT MID$(A$,CURSOR.ROW,CURSOR.LINE-CURSOR.ROW + 1); _
  811.              MID$(LINE.FEED$,1,-(CURSOR.LINE < LEN(A$)));
  812.        CURSOR.ROW = CURSOR.LINE + LEN(RETURN.LINE.FEED$) + 2
  813.      WEND
  814. 1437 IF LOCAL.USER THEN _
  815.         GOTO 1450
  816.      IF UPPER.CASE THEN _
  817.         CALL ALLCAPS (A$)
  818.      IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  819.         PRINT #3,A$;
  820. 1450 IF CR <> 1 THEN _
  821.         CALL SKIPLINE _
  822.      ELSE IF CR > 1 THEN _
  823.              CALL SKIPLINE
  824. 1470 Y$ = ""
  825.      A$ = Y$
  826.      CR = 0
  827.      IF HALT.IT = 0 THEN _
  828.         EXIT SUB
  829.      STOP.INTERRUPTS = RET
  830.      RET = TRUE
  831.      NON.STOP = FALSE
  832.      EXIT SUB
  833. 1475 CR = 2
  834.      A$ = ""
  835.      RET = STOP.INTERRUPTS
  836.      STOP.INTERRUPTS = FALSE
  837.      HALT.IT = 1
  838.      GOTO 1410
  839. 1476 ON ERROR GOTO 0
  840.      EXIT SUB
  841. 1477 ON ERROR GOTO 75
  842.      LINE.STATUS = INP(LINE.STATUS.REGISTER)
  843.      IF RET.ERR = 57 THEN _
  844.         GOTO 1425
  845.      GOTO 1476
  846.      END SUB
  847. ' $SUBTITLE: 'SKIPLINE - subroutine to write a blank line to user'
  848. ' $PAGE
  849. '
  850. '  SUBROUTINE NAME    -- SKIPLINE
  851. '
  852. '  INPUT PARAMETERS   --   PARAMETER             MEANING
  853. '                        LOCAL.USER
  854. '                        MODEM.STATUS.REGISTER
  855. '                        RETURN.LINE.FEED$
  856. '                        SNOOP
  857. '
  858. '  OUTPUT PARAMETERS  -- NONE
  859. '
  860. '  SUBROUTINE PURPOSE -- SKIP A LINE ON THE USER'S TERMINAL
  861. '
  862.      SUB SKIPLINE STATIC
  863. 1485 IF SNOOP THEN _
  864.         PRINT
  865.      IF NOT LOCAL.USER AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
  866.         PRINT #3,RETURN.LINE.FEED$;
  867.      END SUB
  868. ' $SUBTITLE: 'SETCRLF -- subroutine to set up nulls/lf's for output'
  869. ' $PAGE
  870. '
  871. '  SUBROUTINE NAME    -- SETCRLF
  872. '
  873. '  INPUT PARAMETERS   --   PARAMETER          MEANING
  874. '                        CARRIAGE.RETURN$    CARRIAGE RETURN CHARACTER
  875. '                        CI$                 CITY/STATE OF CALLER
  876. '                        LINE.FEED$          LINE FEED CHARACTER
  877. '                        LINE.FEEDS          LINE FEED SWITCH
  878. '                        NUL$                NULL CHARACTER
  879. '
  880. '  OUTPUT PARAMETERS  -- RETURN.LINE.FEED$   END-OF-LINE STRING
  881. '
  882. '  SUBROUTINE PURPOSE -- SET UP THE NECESSARCY NULLS/LINE FEEDS TO END
  883. '                        EACH OUTPUT TO THE COMMUNICATIONS PORT WITH
  884. '
  885.      SUB SETCRLF STATIC
  886. 1496 RETURN.LINE.FEED$ = MID$(CARRIAGE.RETURN$,1,-(CI$ <> "LOCAL")) + _
  887.                          NUL$ + _
  888.                          MID$(LINE.FEED$,1,-LINE.FEEDS)
  889.      END SUB
  890. ' $SUBTITLE: 'TGET -- RBBS-PC common routine to ask a user a question'
  891. ' $PAGE
  892. '
  893. '  SUBROUTINE NAME    -- TGET
  894. '
  895. '  INPUT PARAMETERS   --    PARAMETER                   MEANING
  896. '                         SUBROUTINE.PARAMETER = 1  STANDARD ENTRY
  897. '                         SUBROUTINE.PARAMETER = 2  ENTRY AFTER A FUNCTION KEY
  898. '                                                   HAS BEEN HANDLED
  899. '                                A$                 STRING TO WRITE TO THE
  900. '                                                   COMMUNICATIONS PORT
  901. '
  902. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  903. '                         B$                        STRING THAT WAS ENTERED
  904. '                         Q                         NUMBER OF PARAMETERES THAT
  905. '                                                   WERE ENTERED WHICH WHERE
  906. '                                                   SEPERATED BY A SEMICOLON
  907. '                         B$()                      STRING MATRIX WITH EACH
  908. '                                                   ITEM CONTAIN THE STRING
  909. '                                                   THAT WAS ENTERED BETWEEN
  910. '                                                   SEMICOLONS.
  911. '                         FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  912. '                         YES                       REPLY IS "Y" OR "YES"
  913. '                         NO                        REPLY IS "N" OR "NO"
  914. '                         NON.STOP                  REPLY IS "NS" OR "ns"
  915. '                         KILL.MESSAGE              REPLY IS "K"
  916. '                         REPLY                     REPLY IS "RE"
  917. '
  918. '  SUBROUTINE PURPOSE --  COMMON ROUTINE TO ASK A USER A QUESTION
  919. '
  920.      SUB TGET STATIC
  921.      ON SUBROUTINE.PARAMETER GOTO 1500,1526
  922. '
  923. ' *****************************************************************************
  924. ' *  COMMON INPUT ROUTINE                                                     *
  925. ' *****************************************************************************
  926. '
  927. 1500 CALL CARRIER
  928.      IF SUBROUTINE.PARAMETER = -1 THEN _
  929.         EXIT SUB
  930.      TOA! = FRE("A")
  931.      CALL FINDTIME (AUTO.LOGOFF!)
  932.      AUTO.LOGOFF! = AUTO.LOGOFF! + WAIT.BEFORE.DISCONNECT
  933.      A = 0
  934.      B = 0
  935.      C = 0
  936.      Q = 1
  937.      EOL = FALSE
  938.      YES = FALSE
  939.      B$ = ""
  940.      NO = FALSE
  941.      A$ = A$ + "? "
  942.      SUBROUTINE.PARAMETER = 4
  943.      CALL TPUT
  944.      IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  945.         EXIT SUB
  946.      IF LOCAL.USER THEN _
  947.         LINE INPUT "",B$ : _
  948.         GOTO 1575
  949.      IF PROMPT.BELL AND INP(MODEM.STATUS.REGISTER) >127 THEN _
  950.         PRINT #3,CHR$(7);
  951. 1525 WHILE EOF(3)
  952.        CALL CARRIER
  953.        IF SUBROUTINE.PARAMETER = -1 THEN _
  954.           EXIT SUB
  955.        CALL FINDTIME (TI!)
  956.        IF TI! > AUTO.LOGOFF! THEN _
  957.           SUBROUTINE.PARAMETER = -1 : _
  958.           EXIT SUB
  959.        CALL FINDFUNC
  960.        IF FUNCTION.KEY <> 0 THEN _
  961.           EXIT SUB
  962. 1526   Y$ = KEY.PRESSED$
  963.        IF Y$ <> "" THEN _
  964.           GOTO 1545
  965.      WEND
  966.      CALL CARRIER
  967.      IF SUBROUTINE.PARAMETER = -1 THEN _
  968.         EXIT SUB
  969.      ON ERROR GOTO 80
  970. 1540 Y$ = INPUT$(1,3)
  971.      ON ERROR GOTO 0
  972.      IF TEST.PARITY THEN _
  973.         GOTO 1541 _
  974.      ELSE IF Y$ = CHR$(127) THEN _
  975.              GOTO 1635 _
  976.           ELSE GOTO 1545
  977. 1541 IF ASC(Y$) = 141 THEN _
  978.         OUT LINE.CONTROL.REGISTER,&H1A : _
  979.         EIGHT.BIT = FALSE : _
  980.         TEST.PARITY = FALSE : _
  981.         GR = FALSE
  982.      Y$ = CHR$(ASC(Y$) AND 127)
  983. 1545 IF Y$ = CHR$(8) OR _
  984.         Y$ = CHR$(7) OR _
  985.         Y$ = CHR$(26) OR _
  986.         Y$ = CHR$(227) THEN _
  987.         GOTO 1635
  988.      IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _
  989.         GOTO 1525
  990.      IF Y$ = "^" THEN _
  991.         GOTO 1525
  992.      IF SNOOP THEN _
  993.         PRINT Y$;
  994.      IF NOT HIDDEN AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
  995.         PRINT #3,Y$; _
  996.      ELSE IF INP(MODEM.STATUS.REGISTER) > 127 THEN_
  997.            PRINT #3,".";
  998.      IF Y$ = CARRIAGE.RETURN$ THEN _
  999.         GOTO 1570
  1000.      IF LEN(B$) >= 254 THEN _
  1001.         A$ = "Input too long!" : _
  1002.         SUBROUTINE.PARAMETER = 5 : _
  1003.         CALL TPUT : _
  1004.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1005.            EXIT SUB _
  1006.         ELSE GOTO 1500
  1007.      B$ = B$ + Y$
  1008.      GOTO 1525
  1009. 1570 IF LINE.FEEDS AND INP(MODEM.STATUS.REGISTER) > 127 THEN _
  1010.         PRINT #3,LINE.FEED$;
  1011. 1575 A = INSTR(B$,";")
  1012.      IF A = 0 THEN _
  1013.         GOTO 1620
  1014.      B$(1) = LEFT$(B$,A-1)
  1015.      A = A + 1
  1016. 1585 B = INSTR(A,B$,";")
  1017.      C = B-A
  1018.      IF C < 1 THEN _
  1019.         EOL = TRUE : _
  1020.         C = 128
  1021.      DF$ = MID$(B$,A,C)
  1022.      IF DF$ <> "" THEN _
  1023.         Q = Q + 1 : _
  1024.         B$(Q) = DF$
  1025.      IF NOT EOL AND Q < 10 THEN _
  1026.         A = B + 1 : _
  1027.         GOTO 1585
  1028.      IF LEN(B$) > 64 THEN _
  1029.         A$ = "Try again, " + FIRST.NAME$ : _
  1030.         SUBROUTINE.PARAMETER = 5 : _
  1031.         CALL TPUT : _
  1032.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1033.            EXIT SUB _
  1034.         ELSE GOTO 1500
  1035.      GOTO 1625
  1036. 1620 B$(1) = B$
  1037.      Q = 1
  1038.      IF B$ = "" THEN _
  1039.         Q = 0 : _
  1040.         EXIT SUB
  1041. 1625 CALL ALLCAPS (B$)
  1042.      IF LEFT$(B$,1) = "Y" THEN _
  1043.         YES = TRUE _
  1044.      ELSE IF LEFT$(B$,1) = "N" THEN _
  1045.              NO = TRUE
  1046.      IF B$(Q) = "NS" OR B$(Q) = "ns" THEN _
  1047.         NO = FALSE : _
  1048.         NON.STOP = TRUE : _
  1049.         B$(Q) = "" : _
  1050.         IF Q > 1 THEN _
  1051.            Q = Q-1
  1052.      IF B$ = "RE" AND USER.SECURITY.LEVEL >= MAIN.FUNCTION(4) THEN _
  1053.         REPLY = TRUE : _
  1054.         EXIT SUB
  1055.      IF B$ = "K" AND USER.SECURITY.LEVEL >= MAIN.FUNCTION(10) THEN _
  1056.         KILL.MESSAGE = TRUE
  1057.      EXIT SUB
  1058. 1635 IF LEN(B$) = 0 THEN _
  1059.         GOTO 1525
  1060.      B$ = LEFT$(B$,LEN(B$)-1)
  1061.      IF SNOOP THEN _
  1062.         PRINT BACK.ARROW$;
  1063.      IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  1064.         PRINT #3,BACKSPACE$;
  1065.      GOTO 1525
  1066. 1650 ON ERROR GOTO 80
  1067.      LINE.STATUS = INP(LINE.STATUS.REGISTER)
  1068.      GOTO 1540
  1069. 1651 ON ERROR GOTO 0
  1070.      END SUB
  1071. ' $SUBTITLE: 'SETBAUD - subroutine to set the baud rate in the RS232'
  1072. ' $PAGE
  1073. '
  1074. '  SUBROUTINE NAME    -- SETBAUD
  1075. '
  1076. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1077. '                         BAUD.RATE.DIVISOR   NUMBER TO DIVIDE THE 8250 CHIP'S
  1078. '                                             PROGRAMABLE CLOCK TO ADJUST THE
  1079. '                                             BAUD RATE TO THE USER'S BAUD
  1080. '                                             RATE (INDEPENDENT OF THE BAUD
  1081. '                                             RATE USED TO OPEN THE COMM. PORT)
  1082. '
  1083. '        DESIRED BAUD        DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
  1084. '            RATE              PCjr         PC AND XT
  1085. '              50             2237             2304
  1086. '              75             1491             1536
  1087. '             110             1017             1047
  1088. '             134.5            832              857
  1089. '             150              746              768
  1090. '             300              373              384
  1091. '             600              186              192
  1092. '            1200               93               96
  1093. '            1800               62               64
  1094. '            2000               56               58
  1095. '            2400               47               48
  1096. '            3600               31               32
  1097. '            4800               23               24
  1098. '            7200          not available         16
  1099. '            9600          not available         12
  1100. '
  1101. '  OUTPUT PARAMETERS  -- BAUD RATE SET IN THE RS232 INTERFACE
  1102. '
  1103. '  SUBROUTINE PURPOSE -- TO SET THE BAUD RATE IN THE RS232 INTERFACE
  1104. '                        INDEPENDENT OF THE BAUD RATE THE COMMUNICATIONS PORT
  1105. '                        WAS OPENED AT
  1106. '
  1107.       SUB SETBAUD STATIC
  1108. '
  1109. ' *****************************************************************************
  1110. ' *  BAUD RATE CHANGE ROUTINE                                                 *
  1111. ' *****************************************************************************
  1112. '
  1113. 1654 LINE.CONTROL.STATUS = INP(LINE.CONTROL.REGISTER)
  1114.      MSB.SAVE = INP(MSB)
  1115.      OUT MSB,0
  1116.      OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS OR 128
  1117.      MOST.SIGNIFICANT.BYTE = FIX (BAUD.RATE.DIVISOR / 256)
  1118.      LEAST.SIGNIFICANT.BYTE = BAUD.RATE.DIVISOR - (MOST.SIGNIFICANT.BYTE * 256)
  1119.      OUT LSB,LEAST.SIGNIFICANT.BYTE
  1120.      OUT MSB,MOST.SIGNIFICANT.BYTE
  1121.      OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS
  1122.      OUT MSB,MSB.SAVE
  1123.      END SUB
  1124. ' $SUBTITLE: 'LOGERROR - subroutine to log errors to CALLERS file'
  1125. ' $PAGE
  1126. '
  1127. '  SUBROUTINE NAME    -- LOGERROR
  1128. '
  1129. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1130. '                               ERR           ERROR NUMBER DETECTED BY BASIC
  1131. '                               ERL           LAST LINE NUMBER ENCOUNTERED
  1132. '                                             PRIOR TO ENCOUNTERNING ERROR
  1133. '
  1134. '  OUTPUT PARAMETERS  -- NONE
  1135. '
  1136. '  SUBROUTINE PURPOSE -- TO SET UP A STRING TO WRITE TO THE CALLERS LOG
  1137. '                        INDICATING THE DATE, TIME, ERROR, AND ERROR LINE
  1138. '
  1139.       SUB LOGERROR STATIC
  1140. 13660 A$ = "+++ Error " + _
  1141.            STR$(ERR) + _
  1142.            " line " + _
  1143.            STR$(ERL) + _
  1144.            " at " + _
  1145.            TIME$ + _
  1146.            " on " + _
  1147.            DATE$
  1148.       Z$ = A$
  1149.       SUBROUTINE.PARAMETER = 2
  1150.       CALL UPDTCALR
  1151.       END SUB
  1152. ' $SUBTITLE: 'UPDTCALR - subroutine to write to CALLERS file'
  1153. ' $PAGE
  1154. '
  1155. '  SUBROUTINE NAME    -- UPDTCALR
  1156. '
  1157. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1158. '                                Z$                MESSAGE TO GO IN CALLER LOG
  1159. '                        SUBROUTINE.PARAMETER = 1  CHECK FOR EXTENDED LOGGING
  1160. '                                                  BEFORE UPDATING.
  1161. '                        SUBROUTINE.PARAMETER = 2  UPDATE CALLER LOG WITH Z$
  1162. '
  1163. '  OUTPUT PARAMETERS  -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
  1164. '                        TIM$                    CURRENT TIME (I.E. 1:13 PM)
  1165. '                        TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  1166. '
  1167. '  SUBROUTINE PURPOSE -- TO UPDATE THE CALLER'S FILE AND/OR PRINT ON THE
  1168. '                        LOCAL PRINTER IF IT IS ENABLED
  1169. '
  1170.       SUB UPDTCALR STATIC
  1171.       ON SUBROUTINE.PARAMETER GOTO 13665,13670
  1172. '
  1173. ' *****************************************************************************
  1174. ' * EXTENDED LOGGING ENTRY                                                    *
  1175. ' *****************************************************************************
  1176. '
  1177. 13665 IF NOT EXTENDED.LOGGING THEN _
  1178.          EXIT SUB
  1179.       SUBROUTINE.PARAMETER = 2
  1180.       CALL AMORPM
  1181.       Z$ = Z$ + " at " + TIM$
  1182. '
  1183. ' *****************************************************************************
  1184. ' * UPDATE CALLERS FILE WITH USER ACTIVITY                                    *
  1185. ' *****************************************************************************
  1186. '
  1187. 13670 Z$ = SPACE$(5) + Z$
  1188.       IF NOT LOCAL.USER THEN _
  1189.          LSET CALLERS.RECORD$ = Z$ : _
  1190.          CALLERS.FILE.INDEX = CALLERS.FILE.INDEX + 1 : _
  1191.          PUT 4,CALLERS.FILE.INDEX
  1192.       CALL PRINTIT
  1193.       END SUB
  1194. ' $SUBTITLE: 'PRINTIT - subroutine to print on the local PC's printer'
  1195. ' $PAGE
  1196. '
  1197. '  SUBROUTINE NAME    -- PRINTIT
  1198. '
  1199. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1200. '                                Z$              STRING TO WRITE TO THE PRINTER
  1201. '
  1202. '  OUTPUT PARAMETERS  -- NONE
  1203. '
  1204. '  SUBROUTINE PURPOSE -- TO WRITE TO THE PRINTER ATTACHED TO THE PC RUNNING
  1205. '                        RBBS-PC AND TOGGLE THE PRINTER SWTICH OFF WHENEVER
  1206. '                        THE PRINTER IS/BECOMES UNAVAILABLE
  1207. '
  1208.       SUB PRINTIT STATIC
  1209.       ON ERROR GOTO 65
  1210. 13674 IF PRINTER THEN _
  1211.          LPRINT Z$
  1212.       ON ERROR GOTO 0
  1213.       END SUB
  1214. ' $SUBTITLE: 'FINDIT - subroutine to find if a file exists'
  1215. ' $PAGE
  1216. '
  1217. '  SUBROUTINE NAME    -- FINDIT
  1218. '
  1219. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1220. '                        FILE.NAME$                NAME OF FILE TO FIND
  1221. '
  1222. '  OUTPUT PARAMETERS  -- OK                        TRUE IF FILE EXISTS
  1223. '                        EC                        ERROR CODE
  1224. '
  1225. '  SUBROUTINE PURPOSE -- DETERMINE IF A FILE EXISTS BY RENAMING IT TO ITSELF
  1226. '
  1227.       SUB FINDIT STATIC
  1228.       ON ERROR GOTO 85
  1229.       EC = 0
  1230.       OK = FALSE
  1231. 20221 NAME FILE.NAME$ AS FILE.NAME$
  1232. 20222 ON ERROR GOTO 85
  1233.       CLOSE 2
  1234. 20223 OPEN FILE.NAME$ FOR INPUT AS #2
  1235.       OK = TRUE
  1236. 20224 ON ERROR GOTO 0
  1237.       END SUB
  1238. ' $SUBTITLE: 'BADNAME - subroutine to find bad file names'
  1239. ' $PAGE
  1240. '
  1241. '  SUBROUTINE NAME    -- BADNAME
  1242. '
  1243. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1244. '                        ACTIVE.MESSAGE.FILE$
  1245. '                        ACTIVE.USER.FILE$
  1246. '                        CALLERS.FILE$
  1247. '                        COMMENTS.FILE$
  1248. '                        MAIN.MESSAGE.BACKUP$
  1249. '                        MAIN.MESSAGE.FILE$
  1250. '                        MAXIMUM.VIOLATIONS
  1251. '                        PASSWORDS.FILE$
  1252. '                        RBBS.BAT$
  1253. '                        RCTTY.BAT$
  1254. '                        SUBDIR$()
  1255. '                        SUBDIR.INDEX
  1256. '                        VIOLATION$
  1257. '                        VIOLATIONS.THIS.SESSION
  1258. '                        Z$                          NAME OF FILE
  1259. '
  1260. '  OUTPUT PARAMETERS  -- BAD.FILE.NAME.INDEX         1 = FILE NAME IS OK
  1261. '                                                    2 = SECURITY BREACH TRIED
  1262. '                        VIOLATIONS.THIS.SESSION     NUMBER OF VIOLATIONS
  1263. '                        FILENAME$                   NAME OF FILE
  1264. '
  1265. '  SUBROUTINE PURPOSE -- TO PROTECT RBBS-PC AGAINST THE USE OF BAD FILE NAMES
  1266. '                        TO EITHER CRASH THE SYSTEM OR TO BREACH RBBS-PC'S
  1267. '                        SECURITY
  1268. '
  1269.       SUB BADNAME STATIC
  1270. '
  1271. ' *****************************************************************************
  1272. ' *  TEST FOR SYSTEM FILE ATTEMPT                                             *
  1273. ' *****************************************************************************
  1274. '
  1275. 20235 BAD.FILE.NAME.INDEX = 1
  1276.       Z$ = FILE.NAME$
  1277.       IF INSTR(3,FILE.NAME$,MID$(ACTIVE.MESSAGE.FILE$,3,(LEN(ACTIVE.MESSAGE.FILE$)-2))) THEN _
  1278.          GOTO 20236
  1279.       IF INSTR(3,FILE.NAME$,MID$(ACTIVE.USER.FILE$,3,(LEN(ACTIVE.USER.FILE$)-2))) THEN _
  1280.          GOTO 20236
  1281.       IF INSTR(3,FILE.NAME$,MID$(ACTIVE.USER.FILE$+".BAK",3,(LEN(ACTIVE.USER.FILE$+".BAK")-2))) THEN _
  1282.          GOTO 20236
  1283.       IF INSTR(3,FILE.NAME$,MID$(CALLERS.FILE$,3,(LEN(CALLERS.FILE$)-2))) THEN _
  1284.          GOTO 20236
  1285.       IF INSTR(3,FILE.NAME$,MID$(COMMENTS.FILE$,3,(LEN(COMMENTS.FILE$)-2))) THEN _
  1286.          GOTO 20236
  1287.       IF INSTR(3,FILE.NAME$,MID$(FILESEC.FILE$,3,(LEN(FILESEC.FILE$)-2))) THEN _
  1288.          GOTO 20236
  1289.       IF INSTR(3,FILE.NAME$,MID$(MAIN.MESSAGE.BACKUP$,3,(LEN(MAIN.MESSAGE.BACKUP$)-2))) THEN _
  1290.          GOTO 20236
  1291.       IF INSTR(3,FILE.NAME$,MID$(MAIN.MESSAGE.FILE$,3,(LEN(MAIN.MESSAGE.FILE$)-2))) THEN _
  1292.          GOTO 20236
  1293.       IF INSTR(3,FILE.NAME$,MID$(MAIN.USER.FILE$,3,(LEN(MAIN.USER.FILE$)-2))) THEN _
  1294.          GOTO 20236
  1295.       IF INSTR(3,FILE.NAME$,MID$(MAIN.USER.FILE$+".BAK",3,(LEN(MAIN.USER.FILE$+".BAK")-2))) THEN _
  1296.          GOTO 20236
  1297.       IF INSTR(3,FILE.NAME$,MID$(PASSWORDS.FILE$,3,(LEN(PASSWORDS.FILE$)-2))) THEN _
  1298.          GOTO 20236
  1299.       IF INSTR(3,FILE.NAME$,MID$(RBBS.BAT$,3,(LEN(RBBS.BAT$)-2))) THEN _
  1300.          GOTO 20236
  1301.       IF INSTR(3,FILE.NAME$,MID$(RCTTY.BAT$,3,(LEN(RCTTY.BAT$)-2))) THEN _
  1302.          GOTO 20236
  1303.       EXIT SUB
  1304. 20236 BAD.FILE.NAME.INDEX = 2
  1305.       END SUB
  1306. ' $SUBTITLE: 'BADFILE - subroutine to find bad file names'
  1307. ' $PAGE
  1308. '
  1309. '  SUBROUTINE NAME    -- BADFILE
  1310. '
  1311. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1312. '                        VIOLATION$
  1313. '                        VIOLATIONS.THIS.SESSION
  1314. '                        Z$                          NAME OF FILE
  1315. '
  1316. '  OUTPUT PARAMETERS  -- BAD.FILE.NAME.INDEX         1 = FILE NAME IS OK
  1317. '                                                    2 = CHARACTER NOT ALLOWED
  1318. '                                                    3 = SYSTEM CRASH ATTEMPT
  1319. '                        VIOLATIONS.THIS.SESSION     NUMBER OF VIOLATIONS
  1320. '                        FILENAME$                   NAME OF FILE
  1321. '
  1322. '  SUBROUTINE PURPOSE -- TO PROTECT RBBS-PC AGAINST THE USE OF BAD FILE NAMES
  1323. '                        TO EITHER CRASH THE SYSTEM OR TO BREACH RBBS-PC'S
  1324. '                        SECURITY
  1325. '
  1326.       SUB BADFILE STATIC
  1327. '
  1328. ' *****************************************************************************
  1329. ' *  TEST FOR INVALID CHARACTERS IN FILENAME                                  *
  1330. ' *****************************************************************************
  1331. '
  1332. 20741 BAD.FILE.NAME.INDEX = 1
  1333.       CALL ALLCAPS (Z$)
  1334.       FILE.NAME$ = SUBDIR$(SUBDIR.INDEX) + Z$    
  1335.       IF INSTR(FILE.NAME$,"?") OR _
  1336.          INSTR(FILE.NAME$,"*") OR _
  1337.          INSTR(FILE.NAME$," ") OR _
  1338.          INSTR(3,FILE.NAME$,":") OR _
  1339.          INSTR(FILE.NAME$,".DEF") OR _
  1340.          INSTR(FILE.NAME$,".OLD") OR _
  1341.          MID$(FILE.NAME$,LEN(FILE.NAME$),1) = "." THEN _
  1342.          BAD.FILE.NAME.INDEX = 2 : _
  1343.          EXIT SUB
  1344.       IF LEN(Z$) >= 3 THEN _
  1345.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:PRN:CON:AUX",Z$) THEN _
  1346.             VIOLATIONS.THIS.SESSION = MAXIMUM.VIOLATIONS :  _
  1347.             VIOLATION$ = VIOLATION$ + Z$ : _
  1348.             BAD.FILE.NAME.INDEX = 3
  1349.       END SUB
  1350. ' $SUBTITLE: 'FILELOCK - subroutine to share RBBS-PC files'
  1351. ' $PAGE
  1352. '
  1353. '  SUBROUTINE NAME    -- FILELOCK
  1354. '
  1355. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1356. '                        SUBROUTINE.PARAMETER = 1 UNLOCK USERS AND MESSAGES
  1357. '                                               2 FLUSH MESSAGE RECORD TO DISK
  1358. '                                                 AND UNLOCK MESSAGES
  1359. '                                               3 LOCK MESSAGE FILE
  1360. '                                               4 UNLOCK MESSAGE FILE
  1361. '                                               5 LOCK USER FILE
  1362. '                                               6 LOCK 4 RECORD BLOCK IN USER
  1363. '                                                 FILE
  1364. '                                               7 UNLOCK USER FILE
  1365. '                                               8 UNLOCK 4 RECORD BLOCK IN USER
  1366. '                                                 FILE
  1367. '                                               9 LOCK UPLOAD DIRECTORY OR
  1368. '                                                 COMMENTS FILE
  1369. '                                              10 UNLOCK UPLOAD DIRECTORY OR
  1370. '                                                 COMMENTS FILE
  1371. '                        ACTIVE.MESSAGE FILE$   NAME OF MESSAGE FILE
  1372. '                        ACTIVE.USER.FILE$      NAME OF USER FILE
  1373. '                        CONFIG.FILE.NAME$      FILE NAME TO FLUSH RECORD FROM
  1374. '                        EN$                    UPLOAD DIRECTORY OR COMMENTS
  1375. '                                               FILE NAME TO LOCK/UNLOCK
  1376. '                        NETWORK.TYPE           TYPE OF NETWORK LOCKING TO USE
  1377. '
  1378. '  OUTPUT PARAMETERS  -- SUBROUTINE.PARAMETER = -1 TERMINATE RBBS-PC IMMEDATELY
  1379. '                        BLK
  1380. '                        LOCK.DRIVE
  1381. '                        LOCK.FILE.NAME$
  1382. '                        LOCK.STATUS$
  1383. '                        MESSAGE.FILE.LOCK
  1384. '                        USER.BLOCK.LOCK
  1385. '                        USER.FILE.LOCK
  1386. '                        USER.FILE.INDEX
  1387. '
  1388. '  SUBROUTINE PURPOSE -- TO LOCK AND UNLOCK THE SHARED RBBS-PC FILES WHEN
  1389. '                        MULTIPLE COPIES OF RBBS-PC ARE SHARING THE SAME
  1390. '                        FILES IN EITHER A MULTI-TASKING DOS ENVIRONMENT OR
  1391. '                        IN A LOCAL AREA NETWORK ENVIRONMENT
  1392. '
  1393.       SUB FILELOCK STATIC
  1394.       ON SUBROUTINE.PARAMETER GOSUB 21995,21996,22000,25000,26000,26500,27000,_
  1395.                                     27500,29000,29500
  1396.       EXIT SUB
  1397. '
  1398. ' *****************************************************************************
  1399. ' *  UNLOCK USERS AND MESSAGES                                                *
  1400. ' *****************************************************************************
  1401. '
  1402. 21995 GOSUB 27000
  1403.       GOSUB 25000
  1404.       RETURN
  1405. '
  1406. ' *****************************************************************************
  1407. ' *  FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1                *
  1408. ' *****************************************************************************
  1409. '
  1410. 21996 CLOSE 1
  1411.       IF SHARE.IT THEN _
  1412.          OPEN CONFIG.FILENAME$ FOR INPUT SHARED AS #1 _
  1413.          ELSE OPEN "I",1,CONFIG.FILENAME$
  1414.       CLOSE 1
  1415. '
  1416. ' *****************************************************************************
  1417. ' *  UNLOCK MESSAGES                                                          *
  1418. ' *****************************************************************************
  1419. '
  1420.       GOSUB 25000
  1421.       RETURN
  1422. '
  1423. ' *****************************************************************************
  1424. ' *  LOCK MESSAGE FILE                                                        *
  1425. ' *****************************************************************************
  1426. '
  1427. 22000 MESSAGE.FILE.LOCK = TRUE
  1428.       MID$(LOCK.STATUS$,1,2) = "LM"
  1429.       SUBROUTINE.PARAMETER = 2
  1430.       CALL LINE25
  1431.       LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
  1432.       ON NETWORK.TYPE GOTO 22100,22200,22300
  1433.       RETURN
  1434. '
  1435. ' *****************************************************************************
  1436. ' *  LOCK MESSAGE FILE (MULTI-LINK)                                           *
  1437. ' *****************************************************************************
  1438. '
  1439. 22100 AX = &H0
  1440.       BX = &H1
  1441.       CALL RBBSML(AX,BX)
  1442.       RETURN
  1443. '
  1444. ' *****************************************************************************
  1445. ' *  LOCK MESSAGE FILE (OMNINET)                                              *
  1446. ' *****************************************************************************
  1447. '
  1448. 22200 CC$ = CHR$(1) + MID$(ACTIVE.MESSAGE.FILE$ + SPACE$(8),3,8)
  1449.       GOSUB 28000
  1450.       IF CT = 0 THEN _
  1451.          RETURN
  1452.       SUBROUTINE.PARAMETER = 1
  1453.       CALL DELAYIT
  1454.       GOTO 22200
  1455. '
  1456. ' *****************************************************************************
  1457. ' *  LOCK MESSAGE FILE (ORCHID PC-NET)                                        *
  1458. ' *  LOCK USER FILE (ORCHID PC-NET)                                           *
  1459. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET)           *
  1460. ' *****************************************************************************
  1461. '
  1462. 22300 GOSUB 28100
  1463.       CALL LPLKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1464.       RETURN
  1465. '
  1466. ' *****************************************************************************
  1467. ' *  UNLOCK MESSAGE FILE                                                      *
  1468. ' *****************************************************************************
  1469. '
  1470. 25000 MESSAGE.FILE.LOCK = FALSE
  1471.       MID$(LOCK.STATUS$,1,2) = "UM"
  1472.       SUBROUTINE.PARAMETER = 2
  1473.       CALL LINE25
  1474.       LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
  1475.       ON NETWORK.TYPE GOTO 25100,25200,25300
  1476.       RETURN
  1477. '
  1478. ' *****************************************************************************
  1479. ' *  UNLOCK MESSAGE FILE (MULTI-LINK)                                         *
  1480. ' *****************************************************************************
  1481. '
  1482. 25100 AX = &H100
  1483.       BX = &H1
  1484.       CALL RBBSML(AX,BX)
  1485.       RETURN
  1486. '
  1487. ' *****************************************************************************
  1488. ' *  UNLOCK MESSAGE FILE (OMNINET)                                            *
  1489. ' *****************************************************************************
  1490. '
  1491. 25200 CC$ = CHR$(17) + MID$(ACTIVE.MESSAGE.FILE$ + SPACE$(8),3,8)
  1492.       GOSUB 28000
  1493.       IF CT = 128 THEN _
  1494.          RETURN
  1495.       SUBROUTINE.PARAMETER = 1
  1496.       CALL DELAYIT
  1497.       GOTO 25200
  1498. '
  1499. ' *****************************************************************************
  1500. ' *  UNLOCK MESSAGE FILE (ORCHID PC-NET)                                      *
  1501. ' *  UNLOCK USER FILE (ORCHID PC-NET)                                         *
  1502. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET)         *
  1503. ' *****************************************************************************
  1504. '
  1505. 25300 GOSUB 28100
  1506.       CALL UNLOKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1507.       RETURN
  1508. '
  1509. ' *****************************************************************************
  1510. ' *  LOCK USER FILE                                                           *
  1511. ' *****************************************************************************
  1512. '
  1513. 26000 USER.FILE.LOCK = TRUE
  1514.       MID$(LOCK.STATUS$,4,2) = "LU"
  1515.       SUBROUTINE.PARAMETER = 2
  1516.       CALL LINE25
  1517.       LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
  1518.       ON NETWORK.TYPE GOTO 26100,26200,22300
  1519.       RETURN
  1520. '
  1521. ' *****************************************************************************
  1522. ' *  LOCK USER FILE (MULTI-LINK)                                              *
  1523. ' *****************************************************************************
  1524. '
  1525. 26100 AX = &H0
  1526.       BX = &H2
  1527.       CALL RBBSML(AX,BX)
  1528.       RETURN
  1529. '
  1530. ' *****************************************************************************
  1531. ' *  LOCK USER FILE (OMNINET)                                                 *
  1532. ' *****************************************************************************
  1533. '
  1534. 26200 CC$ = CHR$(1) + MID$(ACTIVE.USER.FILE$ + SPACE$(8),3,8)
  1535.       GOSUB 28000
  1536.       IF CT = 0 THEN _
  1537.          RETURN
  1538.       SUBROUTINE.PARAMETER = 1
  1539.       CALL DELAYIT
  1540.       GOTO 26200
  1541. '
  1542. ' *****************************************************************************
  1543. ' *  LOCK 4 RECORD BLOCK IN USER FILE                                         *
  1544. ' *****************************************************************************
  1545. '
  1546. 26500 USER.BLOCK.LOCK = TRUE
  1547.       BLK = (USER.FILE.INDEX / 4) + .26
  1548.       MID$(LOCK.STATUS$,7,2) = "LB"
  1549.       SUBROUTINE.PARAMETER = 2
  1550.       CALL LINE25
  1551.       ON NETWORK.TYPE GOTO 26600,26700,26800
  1552.       RETURN
  1553. '
  1554. ' *****************************************************************************
  1555. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)                            *
  1556. ' *****************************************************************************
  1557. '
  1558. 26600 AX = &H0
  1559.       BX = BLK + 10
  1560.       CALL RBBSML(AX,BX)
  1561.       RETURN
  1562. '
  1563. ' *****************************************************************************
  1564. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)                               *
  1565. ' *****************************************************************************
  1566. '
  1567. 26700 CC$ = CHR$(1) + "BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1568.       GOSUB 28000
  1569.       IF CT = 0 THEN _
  1570.          RETURN
  1571.       SUBROUTINE.PARAMETER = 1
  1572.       CALL DELAYIT
  1573.       GOTO 26700
  1574. '
  1575. ' *****************************************************************************
  1576. ' *  LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)                         *
  1577. ' *****************************************************************************
  1578. '
  1579. 26800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + "BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1580.       GOTO 22300
  1581. '
  1582. ' *****************************************************************************
  1583. ' *  UNLOCK USER FILE                                                         *
  1584. ' *****************************************************************************
  1585. '
  1586. 27000 USER.FILE.LOCK = FALSE
  1587.       MID$(LOCK.STATUS$,4,2) = "UU"
  1588.       SUBROUTINE.PARAMETER = 2
  1589.       CALL LINE25
  1590.       LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
  1591.       ON NETWORK.TYPE GOTO 27100,27200,25300
  1592.       RETURN
  1593. '
  1594. ' *****************************************************************************
  1595. ' *  UNLOCK USER FILE (MULTI-LINK)                                            *
  1596. ' *****************************************************************************
  1597. '
  1598. 27100 AX = &H100
  1599.       BX = &H2
  1600.       CALL RBBSML(AX,BX)
  1601.       RETURN
  1602. '
  1603. ' *****************************************************************************
  1604. ' *  UNLOCK USER FILE (OMNINET)                                               *
  1605. ' *****************************************************************************
  1606. '
  1607. 27200 CC$ = CHR$(17) + MID$(ACTIVE.USER.FILE$ + SPACE$(8),3,8)
  1608.       GOSUB 28000
  1609.       IF CT = 128 THEN _
  1610.          RETURN
  1611.       SUBROUTINE.PARAMETER = 1
  1612.       CALL DELAYIT
  1613.       GOTO 27200
  1614. '
  1615. ' *****************************************************************************
  1616. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE                                       *
  1617. ' *****************************************************************************
  1618. '
  1619. 27500 USER.BLOCK.LOCK = FALSE
  1620.       BLK = (USER.FILE.INDEX / 4) + .26
  1621.       MID$(LOCK.STATUS$,7,2) = "UB"
  1622.       SUBROUTINE.PARAMETER = 2
  1623.       CALL LINE25
  1624.       ON NETWORK.TYPE GOTO 27600,27700,27800
  1625.       RETURN
  1626. '
  1627. ' *****************************************************************************
  1628. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)                          *
  1629. ' *****************************************************************************
  1630. '
  1631. 27600 AX = &H100
  1632.       BX = BLK + 10
  1633.       CALL RBBSML(AX,BX)
  1634.       RETURN
  1635. '
  1636. ' *****************************************************************************
  1637. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)                             *
  1638. ' *****************************************************************************
  1639. '
  1640. 27700 CC$ = CHR$(17) + "BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1641.       GOSUB 28000
  1642.       IF CT = 128 THEN _
  1643.          RETURN
  1644.       SUBROUTINE.PARAMETER = 1
  1645.       CALL DELAYIT
  1646.       GOTO 27700
  1647. '
  1648. ' *****************************************************************************
  1649. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)                       *
  1650. ' *****************************************************************************
  1651. '
  1652. 27800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + "BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1653.       GOTO 25300
  1654. '
  1655. ' *****************************************************************************
  1656. ' *  CORVUS OMNINET INTERFACE                                                 *
  1657. ' *****************************************************************************
  1658. '
  1659. 28000 CC$ = LINE.FEED$ + CHR$(0) + CHR$(11) + CC$
  1660.       CALL CDSEND(CC$)
  1661.       CALL CDRECV(CN$)
  1662.       CT = ASC(MID$(CN$,3,1))
  1663.       IF CT >= 128 THEN _
  1664.          PRINT "CORVUS LOCK FAIL" : _
  1665.          SUBROUTINE.PARAMETER = -1
  1666. 28010 CT = ASC(MID$(CN$,4,1))
  1667.       IF CT >= 129 THEN _
  1668.          PRINT "CORVUS FULL" : _
  1669.          SUBROUTINE.PARAMETER = -1
  1670.       RETURN
  1671. '
  1672. ' *****************************************************************************
  1673. ' *  ORCHID PC-NET INTERFACE                                                  *
  1674. ' *****************************************************************************
  1675. '
  1676. 28100 LOCK.DRIVE = ASC(LEFT$(ACTIVE.USER.FILE$,1))-ASC("A")
  1677.       LOCK.FILE.NAME$ = LOCK.FILE.NAME$ + _
  1678.                         STRING$(32-LEN(LOCK.FILE.NAME$),0)
  1679.       A = 0
  1680.       RETURN
  1681. '
  1682. ' *****************************************************************************
  1683. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$                           *
  1684. ' *****************************************************************************
  1685. '
  1686. 29000 MID$(LOCK.STATUS$,10,2) = "LD"
  1687.       SUBROUTINE.PARAMETER = 2
  1688.       CALL LINE25
  1689.       LOCK.FILE.NAME$ = EN$
  1690.       ON NETWORK.TYPE GOTO 29100,29010,22300
  1691. 29010 RETURN
  1692. '
  1693. ' *****************************************************************************
  1694. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK)              *
  1695. ' *****************************************************************************
  1696. '
  1697. 29100 AX = &H0
  1698.       BX = &H3
  1699.       CALL RBBSML(AX,BX)
  1700.       RETURN
  1701. '
  1702. ' *****************************************************************************
  1703. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$                         *
  1704. ' *****************************************************************************
  1705. '
  1706. 29500 MID$(LOCK.STATUS$,10,2) = "UD"
  1707.       SUBROUTINE.PARAMETER = 2
  1708.       CALL LINE25
  1709.       LOCK.FILE.NAME$ = EN$
  1710.       ON NETWORK.TYPE GOTO 29600,29510,25300
  1711. 29510 RETURN
  1712. '
  1713. ' *****************************************************************************
  1714. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK)            *
  1715. ' *****************************************************************************
  1716. '
  1717. 29600 AX = &H100
  1718.       BX = &H3
  1719.       CALL RBBSML(AX,BX)
  1720.       EXIT SUB
  1721.       END SUB
  1722. ' $SUBTITLE: 'AMORPM - subroutine to give time of day in AM/PM format'
  1723. ' $PAGE
  1724. '
  1725. '  SUBROUTINE NAME    -- AMORPM
  1726. '
  1727. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1728. '                        SUBROUTINE.PARAMETER = 1  GET CURRENT TIME AND DATE
  1729. '                        SUBROUTINE.PARAMETER = 2  CALCULATE TIME AS AM OR PM
  1730. '
  1731. '  OUTPUT PARAMETERS  -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
  1732. '                        TIM$                    CURRENT TIME (I.E. 1:13 PM)
  1733. '                        TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  1734. '
  1735. '  SUBROUTINE PURPOSE -- TO SET THE OUTPUT PARAMETERS AS INDICATED AND
  1736. '                        DESCRIBE THE TIME AS "AM" OR "PM."
  1737. '
  1738.       SUB AMORPM STATIC
  1739.       ON SUBROUTINE.PARAMETER GOTO 41500,41510
  1740. '
  1741. ' *****************************************************************************
  1742. ' *  CALCULATE CURRENT TIME FOR AM OR PM                                      *
  1743. ' *****************************************************************************
  1744. '
  1745. 41500 TIME.LOGGED.ON$ = TIME$
  1746.       CURRENT.DATE$ = LEFT$(DATE$ ,6) + RIGHT$(DATE$ ,2)
  1747. 41510 TIM$ = TIME$
  1748.       IF VAL(MID$(TIM$,1,2)) = 12 THEN _
  1749.          MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))),2) : _
  1750.          TIM$ = LEFT$(TIM$,5) + " PM" : _
  1751.          EXIT SUB
  1752.       IF VAL(MID$(TIM$,1,2)) > 11 THEN _
  1753.          MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))-12),2) : _
  1754.          TIM$ = LEFT$(TIM$,5) + " PM" : _
  1755.          EXIT SUB
  1756.       TIM$ = LEFT$(TIM$,5) + " AM"
  1757.       END SUB
  1758. ' $SUBTITLE: 'CARRIER - subroutine to monitor carrier on comm. port'
  1759. ' $PAGE
  1760. '
  1761. '  SUBROUTINE NAME    -- CARRIER
  1762. '
  1763. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1764. '                         LOCAL.USER = 0               REMOTE USER
  1765. '                         LOCAL.USER = -1              LOCAL KEYBOARD USER
  1766. '                         MODEM.STATUS.REGISTER        ADDRESS OF THE COMMUNI-
  1767. '                                                      CATIONS PORT'S REGISTER
  1768. '
  1769. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = 0     CARRIER STILL PRESENT
  1770. '                         SUBROUTINE.PARAMETER = -1    CARRIER NOT PRESENT
  1771. '
  1772. '  SUBROUTINE PURPOSE --  TO TEST IF CARRIER IS PRESENT (I.E. THE USER
  1773. '                         STILL ON LINE).
  1774. '
  1775.       SUB CARRIER STATIC
  1776.       SUBROUTINE.PARAMETER = 0
  1777. '
  1778. ' *****************************************************************************
  1779. ' * TEST FOR CARRIER PRESENT (DROP CALLER IF CARRIER NOT PRESENT)             *
  1780. ' *****************************************************************************
  1781. '
  1782. 42000 IF LOCAL.USER THEN _
  1783.          EXIT SUB
  1784. 42010 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  1785.          EXIT SUB
  1786. '
  1787. ' *****************************************************************************
  1788. ' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR CARRIER     *
  1789. ' * DETECT.  SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE CARRIER,   *
  1790. ' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN.                         *
  1791. ' *****************************************************************************
  1792. '
  1793.       SUBROUTINE.PARAMETER = 3
  1794.       CALL DELAYIT
  1795.       SUBROUTINE.PARAMETER = 0
  1796.       IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  1797.          EXIT SUB
  1798.       Z$ = "Carrier dropped"
  1799.       SUBROUTINE.PARAMETER = 1
  1800.       CALL UPDTCALR
  1801.       SUBROUTINE.PARAMETER = -1
  1802.       END SUB
  1803. ' $SUBTITLE: 'READPROF - subroutine to restore a user profile'
  1804. ' $PAGE
  1805. '
  1806. '  SUBROUTINE NAME    -- READPROF
  1807. '
  1808. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1809. '                        NODE.RECORD.INDEX     NODE RECORD TO USE
  1810. '                        SYSOP.PASSWORD.1$     SYSOP'S PSEUDONYM 1
  1811. '                        SYSOP.PASSWORD.2$     SYSOP'S PSEUDONYM 2
  1812. '
  1813. '  OUTPUT PARAMETERS  -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  1814. '                        UPON EXITING RBBS-PC TO A "DOOR"
  1815. '
  1816. '  SUBROUTINE PURPOSE -- RESET A USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  1817. '                        THAT WERE SAVED IN THE NODE RECORD WHEN A USER EXITED
  1818. '                        TO A "DOOR" SO THAT HE IS IN THE SAME STATUS AS WHEN
  1819. '                        HE EXITED.
  1820. '
  1821.       SUB READPROF STATIC
  1822. '
  1823. ' *****************************************************************************
  1824. ' *  RESTORE USER PROFILE WHEN RETURNING FROM DOORS                           *
  1825. ' *****************************************************************************
  1826. '
  1827. 44000 PRINT "NODE.RECORD.INDEX", NODE.RECORD.INDEX
  1828.       GET 1,NODE.RECORD.INDEX
  1829.       EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2))
  1830.       BPS = VAL(MID$(MESSAGE.RECORD$,44,2))
  1831.       PRINT "BPS",BPS
  1832.       CALL COMMINFO
  1833.       UPPER.CASE = VAL(MID$(MESSAGE.RECORD$,46,2))
  1834.       MINUTES.PER.SESSION! = VAL(MID$(MESSAGE.RECORD$,48,5))
  1835.       GR = VAL(MID$(MESSAGE.RECORD$,53,2))
  1836.       SYSOP = VAL(MID$(MESSAGE.RECORD$,55,2))
  1837.       IF BPS = -1 THEN _
  1838.          BAUD.RATE.DIVISOR = &H180:'                                   300 BAUD
  1839.       IF BPS = -2 THEN _
  1840.          BAUD.RATE.DIVISOR = &H100:'                                   450 BAUD
  1841.       IF BPS = -3 THEN _
  1842.          BAUD.RATE.DIVISOR = &H60:'                                   1200 BAUD
  1843.       IF BPS = -4 THEN _
  1844.          BAUD.RATE.DIVISOR = &H30:'                                   2400 BAUD
  1845.       CALL SETBAUD
  1846.       CALL FINDTIME (USER.LOGON.TIME!)
  1847.       IF MINUTES.PER.SESSION! < 1 THEN _
  1848.          MINUTES.PER.SESSION! = 3
  1849.       IF NOT EIGHT.BIT THEN _
  1850.          OUT LINE.CONTROL.REGISTER,&H1A
  1851.       IF SYSOP THEN _
  1852.          FIRST.NAME$ = SYSOP.PASSWORD.1$ : _
  1853.          LAST.NAME$ = SYSOP.PASSWORD.2$ : _
  1854.          EXIT SUB
  1855.       FIRST.NAME.END = INSTR(MESSAGE.RECORD$," ")
  1856.       LAST.NAME.END = INSTR(FIRST.NAME.END + 1,MESSAGE.RECORD$," ")
  1857.       FIRST.NAME$ = LEFT$(MESSAGE.RECORD$,FIRST.NAME.END-1)
  1858.       LAST.NAME$ = MID$(MESSAGE.RECORD$,FIRST.NAME.END + 1,LAST.NAME.END-(FIRST.NAME.END + 1))
  1859.       ACTIVE.USER.NAME$ = MID$(FIRST.NAME$ + " " + LAST.NAME$,1,31)
  1860.       Z$ = FIRST.NAME$
  1861.       END SUB
  1862. ' $SUBTITLE: 'COMMINFO - subroutine for variable of users baud/parity'
  1863. ' $PAGE
  1864. '
  1865. '  SUBROUTINE NAME    -- COMMINFO
  1866. '
  1867. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1868. '                              BPS               BAUD RATE INDICATOR
  1869. '                            EIGHT.BIT           INDICATE FOR N/8/1
  1870. '
  1871. '  OUTPUT PARAMETERS  -- BAUD.PARITY$
  1872. '
  1873. '  SUBROUTINE PURPOSE -- CREATE A STRING THAT SHOWS A USERS BAUD RATE AND
  1874. '                        PARITY.
  1875. '
  1876.       SUB COMMINFO STATIC
  1877. '
  1878. ' *****************************************************************************
  1879. ' *  DETERMINE BAUD AND PARITY                                                *
  1880. ' *****************************************************************************
  1881. '
  1882.   BAUD.PARITY$ = MID$("    300 4501200240048009600",(-4*BPS),4) + _
  1883.                  " BAUD," + _
  1884.                  MID$("N,8,1E,7,1",6 + 5*EIGHT.BIT,5)
  1885.   END SUB
  1886. ' $SUBTITLE: 'DELAYIT - subroutine to wait number of seconds specified'
  1887. ' $PAGE
  1888. '
  1889. '  SUBROUTINE NAME    -- DELAYIT
  1890. '
  1891. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1892. '                        SUBROUTINE.PARAMETER = 1  NUMBER OF SECONDS TO DELAY
  1893. '                                                  (0 TO 3,600)
  1894. '
  1895. '  OUTPUT PARAMETERS  -- NONE
  1896. '
  1897. '  SUBROUTINE PURPOSE -- TO WAIT THE NUMBER OF SECONDS INDICATED BEFORE
  1898. '                        RETURNING CONTROL TO THE CALLING ROUTINE.
  1899. '
  1900.       SUB DELAYIT STATIC
  1901.       CALL FINDTIME (DELAY!)
  1902.       DELAY! = SUBROUTINE.PARAMETER + DELAY!
  1903.       IF DELAY! < 86400! THEN _
  1904.          GOTO 50520
  1905. 50500 CALL FINDTIME (TI!)
  1906.       IF TI! > SUBROUTINE.PARAMETER THEN _  ' IF SECONDS TO DELAY IS PAST
  1907.          GOTO 50500              ' MIDNIGHT WAIT FOR THE CLOCK TO WRAP AROUND
  1908.       DELAY! = DELAY! - 86400!   ' TO PAST MIDNIGHT AND ADJUST THE DELAY
  1909. 50520 CALL FINDTIME (TI!)
  1910.       IF TI! < DELAY! THEN _
  1911.          GOTO 50520
  1912.       END SUB
  1913. ' $SUBTITLE: 'FINDFREE - subroutine to find space on a device'
  1914. ' $PAGE
  1915. '
  1916. '  SUBROUTINE NAME    -- FINDFREE
  1917. '
  1918. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1919. '                        Z$                        NAME OF FILE TO FIND
  1920. '
  1921. '  OUTPUT PARAMETERS  -- FREE.SPACE$               NUMBER OF BYTES FREE
  1922. '
  1923. '  SUBROUTINE PURPOSE -- TO DETERMINE AMOUNT OF FREE SPACE ON A DEVICE
  1924. '
  1925.       SUB FINDFREE STATIC
  1926. '
  1927. ' *****************************************************************************
  1928. ' *  GET FREE SPACE ON DISK                                                   *
  1929. ' *****************************************************************************
  1930. '
  1931. 52000 FREE.SPACE$ = ""
  1932.       CLS
  1933.       ON ERROR GOTO 90
  1934. 52001 FILES Z$
  1935.       ON ERROR GOTO 0
  1936.       FOR X = 1 TO 25
  1937.         FREE.SPACE$ = FREE.SPACE$ + CHR$(SCREEN (3,X))
  1938.       NEXT
  1939. 52002 ON ERROR GOTO 0
  1940.       SUBROUTINE.PARAMETER = 1
  1941.       CALL LINE25
  1942.       END SUB
  1943. ' $SUBTITLE: 'MODEMPUT - subroutine to write modem commands to modem'
  1944. ' $PAGE
  1945. '
  1946. '  SUBROUTINE NAME    -- MODEMPUT
  1947. '
  1948. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1949. '                        A$                        MODEM COMMAND
  1950. '                        COMMANDS.BETWEEN.RINGS    INDICATOR TO WAIT FOR
  1951. '                                                  MODEM TO STOP RINGING
  1952. '                                                  BEFORE ISSUING COMMANDS
  1953. '                        DUMB.MODEM                INDICATOR THAT MODEM WOULD
  1954. '                                                  NOT UNDERSTAND COMMANDS
  1955. '
  1956. '  OUTPUT PARAMETERS  -- NONE
  1957. '
  1958. '  SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM
  1959. '
  1960.       SUB MODEMPUT STATIC
  1961. '
  1962. ' *****************************************************************************
  1963. ' *  SEND MODEM COMMAND                                                       *
  1964. ' *****************************************************************************
  1965. '
  1966. 52070 IF DUMB.MODEM THEN _
  1967.          EXIT SUB
  1968.       IF COMMANDS.BETWEEN.RINGS THEN _
  1969.          WHILE(INP(MODEM.STATUS.REGISTER) AND &H40) > 0 : _
  1970.          WEND
  1971.       SUBROUTINE.PARAMETER = 1
  1972.       CALL DELAYIT
  1973.       PRINT #3,A$
  1974.       END SUB
  1975. ' $SUBTITLE: 'OPENWORK - subroutine to open RBBS-PC's work file (2)'
  1976. ' $PAGE
  1977. '
  1978. '  SUBROUTINE NAME    -- OPENWORK
  1979. '
  1980. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1981. '                        FILE.NAME$                NAME OF FILE TO FIND
  1982. '                        SHARE.IT                  USE DOS' "SHARE" FACILITIES
  1983. '
  1984. '  OUTPUT PARAMETERS  -- EC                        ERROR CODE
  1985. '
  1986. '  SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2)
  1987. '
  1988.       SUB OPENWORK STATIC
  1989. '
  1990. ' *****************************************************************************
  1991. ' * OPEN RBBS-PC'S "WORK FILE" (I.E. FILE NUMBER 2) FOR INPUT.  OPEN IT AS    *
  1992. ' * "SHARED" IF MULTIPLE COPIES OF RBBS-PC WILL BE RUNNING UNDER THE SAME DOS *
  1993. ' *****************************************************************************
  1994. '
  1995. 58000 CLOSE 2
  1996. 58010 EC = 0
  1997.       ON ERROR GOTO 95
  1998. 58020 IF SHARE.IT THEN _
  1999.          OPEN FILE.NAME$ FOR INPUT SHARED AS #2 _
  2000.       ELSE OPEN FILE.NAME$ FOR INPUT AS #2
  2001. 58030 ON ERROR GOTO 0
  2002.       END SUB
  2003. ' $SUBTITLE: 'FINDFUNC - subroutine to find if function key was pressed'
  2004. ' $PAGE
  2005. '
  2006. '  SUBROUTINE NAME    -- FINDFUNC
  2007. '
  2008. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2009. '                        F1.KEY           FUNCTION KEY ONE VALUE
  2010. '                        F10.KEY          FUNCTION KEY TEN VALUE
  2011. '
  2012. '  OUTPUT PARAMETERS  -- FUNCTION.KEY (VALUE 1 TO 10 CORRESPONDING TO
  2013. '                                      THE FUNCTION KEY THAT WAS PRESSED).
  2014. '                        KEY.PRESSED$ (CHARACTER STRING INPUTTED).
  2015. '
  2016. '  SUBROUTINE PURPOSE -- TO DETERMINE IF A FUNCTION HAS BEEN PRESSED ON
  2017. '                        THE PC'S KEYBOARD THAT IS RUNNING RBBS-PC.
  2018. '
  2019.       SUB FINDFUNC STATIC
  2020. '
  2021. ' *****************************************************************************
  2022. ' *  TEST FOR FUNCTION KEY PRESSED                                            *
  2023. ' *****************************************************************************
  2024. '
  2025.       KEY.PRESSED$ = INKEY$
  2026.       FUNCTION.KEY = 0
  2027.       IF LEN(KEY.PRESSED$) <> 2 THEN _
  2028.          EXIT SUB
  2029.       KEY.PRESSED = ASC(RIGHT$(KEY.PRESSED$,1))
  2030.       IF KEY.PRESSED = 79 THEN _
  2031.          FUNCTION.KEY = 11 : _
  2032.          EXIT SUB
  2033.       IF KEY.PRESSED = 73 THEN _
  2034.          FUNCTION.KEY = 12 : _
  2035.          EXIT SUB
  2036.       IF KEY.PRESSED = 81 THEN _
  2037.          FUNCTION.KEY = 13 : _
  2038.          EXIT SUB
  2039.       IF KEY.PRESSED < F1.KEY OR _
  2040.          KEY.PRESSED > F10.KEY THEN _
  2041.          EXIT SUB
  2042.       FUNCTION.KEY = KEY.PRESSED - 58
  2043.       END SUB
  2044. ' $SUBTITLE: 'FINDTIME - subroutine to calculate seconds since midnight'
  2045. ' $PAGE
  2046. '
  2047. '  SUBROUTINE NAME    -- FINDTIME
  2048. '
  2049. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2050. '                            SECONDS!          VARIABLE TO RETURN RESULTS WITH
  2051. '
  2052. '  OUTPUT PARAMETERS  --     SECONDS!          SECONDS SINCE MIDNIGHT
  2053. '
  2054. '  SUBROUTINE PURPOSE -- TO CALCULATE THE NUMBER OF SECONDS THAT HAVE
  2055. '                        ELASPED SINCE MIDNIGHT
  2056. '
  2057.       SUB FINDTIME (SECONDS!) STATIC
  2058.       XTIME$ = TIME$
  2059.       SECONDS! = VAL (RIGHT$(XTIME$,2)) + _
  2060.                  VAL (RIGHT$(XTIME$,5)) * 60 + _
  2061.                  VAL (RIGHT$(XTIME$,8)) * 3600
  2062.       END SUB
  2063. ' $SUBTITLE: 'ALLCAPS - subroutine to convert string to upper case'
  2064. ' $PAGE
  2065. '
  2066. '  SUBROUTINE NAME    -- ALLCAPS
  2067. '
  2068. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2069. '                            CONVERT.FIELD$    STRING TO MAKE UPPER CASE
  2070. '
  2071. '  OUTPUT PARAMETERS  --     CONVERT.FIELD$    CONVERTED STRINGS
  2072. '
  2073. '  SUBROUTINE PURPOSE -- SUBROUTINE TO CONVERT A STRING TO UPPER CASE
  2074. '
  2075.       SUB ALLCAPS (CONVERT.FIELD$) STATIC
  2076.       FOR Z = 1 TO LEN(CONVERT.FIELD$)
  2077.           IF MID$(CONVERT.FIELD$,Z,1) > "@" THEN _
  2078.              MID$(CONVERT.FIELD$,Z,1) = CHR$(ASC(MID$(CONVERT.FIELD$,Z,1)) AND 223)
  2079.       NEXT
  2080.       END SUB
  2081. ' $SUBTITLE: 'CHECKTIM - subroutine to see if time has elasped'
  2082. ' $PAGE
  2083. '
  2084. '  SUBROUTINE NAME    -- CHECKTIM
  2085. '
  2086. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2087. '                            MAX.TIME!         NUMBER OF SECONDS PAST MIDNIGHT
  2088. '                                              NOT TO EXCEED
  2089. '
  2090. '  OUTPUT PARAMETERS  -- SUBROUTINE.PARAMETER = 1 CURRENT TIME IS LESS THAN
  2091. '                                                 MAX.TIME!
  2092. '                        SUBROUTINE.PARAMETER = 2 CURRENT TIME IS GREATER THAN
  2093. '                                                 OR EQUAL TO MAX.TIME!
  2094. '
  2095. '  SUBROUTINE PURPOSE -- SUBROUTINE TO CHECK IF THE CURRENT TIME IS GREATER
  2096. '                        THAN OR EQUAL TO THE TIME ALLOWED
  2097. '
  2098.       SUB CHECKTIM (MAX.TIME!) STATIC
  2099.       SUBROUTINE.PARAMETER = 1
  2100.       CALL FINDTIME (TI!)
  2101.       IF MAX.TIME! < 86400 AND TI! < MAX.TIME! THEN _
  2102.          EXIT SUB
  2103.       IF MAX.TIME! < 86400 AND TI! => MAX.TIME! THEN _
  2104.          SUBROUTINE.PARAMETER = 2 : _
  2105.          EXIT SUB
  2106.       TEST.TIME! = MAX.TIME! - 86400
  2107.       IF TEST.TIME! - TI! <= 0 THEN _
  2108.          EXIT SUB
  2109.       IF TI! => TEST.TIME! THEN _
  2110.          SUBROUTINE.PARAMETER = 2
  2111.       END SUB
  2112.